home *** CD-ROM | disk | FTP | other *** search
/ IRIX Installation Tools & Overlays 2002 November / SGI IRIX Installation Tools & Overlays 2002 November - Disc 4.iso / dist / cluster_admin.idb / var / cluster / ha / diags / libdiags.pl.z / libdiags.pl
Perl Script  |  2002-10-15  |  93KB  |  3,240 lines
  1. #!/usr/sbin/perl
  2. #
  3. #  Copyright (C) 1998-2000, Silicon Graphics, Inc.
  4. #  All Rights Reserved.
  5. #
  6. #  UNPUBLISHED -- Rights reserved under the copyright laws of the United
  7. #  States.  Use of a copyright notice is precautionary only and does not
  8. #  imply publication or disclosure.
  9. #
  10. #  THIS SOFTWARE CONTAINS CONFIDENTIAL AND PROPRIETARY INFORMATION OF
  11. #  SILICON GRAPHICS, INC. ANY DUPLICATION, MODIFICATION, DISTRIBUTION, OR
  12. #  DISCLOSURE IS STRICTLY PROHIBITED WITHOUT THE PRIOR EXPRESS WRITTEN
  13. #  PERMISSION OF SILICON GRAPHICS, INC.
  14. #
  15. #  U.S. GOVERNMENT RESTRICTED RIGHTS LEGEND
  16. #  Use, duplication or disclosure by the Government is subject to
  17. #  restrictions as set forth in FAR 52.227.19(c)(2) or subparagraph
  18. #  (c)(1)(ii) of the Rights in Technical Data and Computer Software
  19. #  clause at DFARS 252.227-7013 and/or in similar or successor clauses
  20. #  in the FAR, or the DOD or NASA FAR Supplement.  Unpublished-- rights
  21. #  reserved under the copyright laws of the United States.
  22. #  Contractor/manufacturer is Silicon Graphics, Inc.,
  23. #  2011 N. Shoreline Blvd., Mountain View, CA 94039-7311.
  24. #
  25.  
  26. # General perl library for ClusterDiags to use
  27.  
  28. require "ctime.pl";
  29.  
  30. select(STDERR); $| = 1;
  31. select(STDOUT); $| = 1;
  32.  
  33. use POSIX;
  34.  
  35. # NodetoHostname
  36. #  Convert the nodename to the actual hostname and place it
  37. #  in a global hash table.
  38. sub NodetoHostname {
  39.   local (@nodes,$node);
  40.   local ($cmd);
  41.   local (@tmp);
  42.   local ($line);
  43.   local ($name, $val);
  44.  
  45.   %NodeToHost = ();    # Clear the table.
  46.   @nodes=GetAllMachines();
  47.   if (scalar (@nodes) < 1) {
  48.      &Failure("No machines configured");
  49.      exit(1);
  50.   }
  51.   foreach $node (@nodes) {
  52.      $cmd="$CLI_PATH/machineQuery _NUM_MACHINES=1 _MACHINE_0=$node";
  53.      @tmp=&do_cmd_with_timeout($cmd,10);
  54.      foreach $line (@tmp) {
  55.         ($name,$val)=split(': ',$line);
  56.         if ( $line =~ /Hostname/ ) {
  57.        &Log("Node %s associated with hostname %s.",$node,$val);
  58.            $NodeToHost{$node}=$val;
  59.         }
  60.      }
  61.   }
  62.   return $node;
  63. }
  64.  
  65. sub alarm_call {
  66.  
  67.    local($pack, $file, $line, $subname, $hasargs, $wantarray);
  68.  
  69.    ($pack, $file, $line, $subname, $hasargs, $wantarray)=caller(1);
  70.    &Failure("rsh Command timeout: SubName:%s Line:%d",$subname,$line);
  71.    $SIG_TIMEOUT=1;
  72. }
  73.  
  74. # rsh
  75. #  Special implementation of the rsh command.
  76. #
  77. #  Calling sequence
  78. #
  79. #  @output=rsh("machinename.domain.com","date");
  80. #  if ($output[0] eq $NULL) {
  81. #        printf("Error encountered\n");
  82. #   } else {
  83. #        ...
  84. #   }
  85.  
  86. sub rsh {
  87.    local ($node,$cmd) = @_;
  88.    local ($command);
  89.    local ($hostname);
  90.    local (@output,$i,@retv);
  91.    local ($old_sig);
  92.  
  93.    if ($node eq $NULL) {
  94.       &InternalError(__LINE__,__FILE__,"Must supply a host\n");
  95.       return ($NULL);
  96.    }
  97.    if ($cmd eq $NULL) {
  98.       &InternalError(__LINE__,__FILE__,"Must supply a command\n");
  99.       return ($NULL);
  100.    }
  101.  
  102.    $hostname=$NodeToHost{$node};
  103.    if (! defined($hostname) || $hostname eq "") {
  104.        $hostname=$node;
  105.    }
  106.    if (gethostbyname($hostname) eq "") {
  107.       &InternalError(__LINE__,__FILE__,"No such host %s [%s]\n",$host,
  108.              $hostname);
  109.       return ($NULL);
  110.    }
  111.  
  112.    # create a temporay script file to be interpreted by /bin/sh on the other
  113.    # node
  114.    open (scr_file, "> /tmp/s1");
  115.    print scr_file $cmd, "\n";
  116.    print scr_file "echo \$\?", "\n";
  117.    close(scr_file);
  118.  
  119.    `/usr/bsd/rcp /tmp/s1 $hostname:/tmp/s1`;
  120.     $error_code=$?;
  121.     if ( $error_code != 0 ) {
  122.     $RSH_ERRNO=1;
  123.     $local_host=`hostname`;
  124.     chop($local_host);
  125.     &Failure("Connection to $hostname from $local_host failed");
  126.     &Suggest("(1) Ensure node '$hostname' has superuser access from $local_host");
  127.     &Suggest("(2) Ensure address '$hostname' is valid.");
  128.     return ($NULL);
  129.     }
  130.  
  131.    $command="/usr/bsd/rsh $hostname '/bin/sh /tmp/s1'";
  132.    &Log("Executing command $command");
  133.  
  134.    $old_sig = $SIG{'ALRM'};
  135.    $SIG{'ALRM'} = \&alarm_call;
  136.    alarm (60);
  137.    eval {@output=`$command`};
  138.    alarm (0);
  139.    $SIG{ALRM} = $old_sig;
  140.  
  141.    # clean up the temporary file created, one of the unlink becomes
  142.    # unnecessary if the machine from which diags are run belongs to
  143.    # the cluster. So need to test the existence of file before
  144.    # deleting it.
  145.  
  146.    `/usr/bin/test -f /tmp/s1 && /bin/rm /tmp/s1`;
  147.  
  148.    `/usr/bsd/rsh $hostname '/usr/bin/test -f /tmp/s1 && /bin/rm /tmp/s1'`;
  149.  
  150.    if ($SIG_TIMEOUT) {
  151.       $RSH_ERRNO=1;
  152.       return $NULL;
  153.    }
  154.  
  155.    if ($@ ne "") {
  156.       &Failure("command failure $@\n");
  157.       return ($NULL);
  158.    }
  159.  
  160.    $RSH_ERRNO=$output[scalar(@output)-1];
  161.  
  162.    chomp(@output);
  163.  
  164.    for ($i=0; $i < scalar(@output)-1; $i++) {
  165.       $retv[$i]=$output[$i];
  166.    }
  167.    if ($verbose) {
  168.       # For debugging purposes only.
  169.       printf("IP:$command\n");
  170.       for ($i=0; $i < scalar(@retv); $i++) {
  171.          printf("OP: $retv[$i]\n");
  172.       }
  173.    }
  174.    return(@retv);
  175. }
  176.  
  177. # TailLogFile
  178. #   Print out the last 5 lines from the log file
  179. sub TailLogFile
  180. {
  181.   local ($node,$file) = @_;
  182.   local ($cmd,@output);
  183.   local ($line,$i);
  184.  
  185.   $cmd="tail -5 $LOG_DIR/$file";
  186.   @output=&rsh($node,$cmd);
  187.   &Notice("Check file $LOG_DIR/$file on node $node (hostname $NodeToHost{$node}) for more information\n");
  188.   &Notice("Last 5 entires from script log file ...\n");
  189.  
  190.   if ($RSH_ERRNO == 0 ) {
  191.      for ($i=0; $i < scalar(@output); $i++) {
  192.         printf("$output[$i]\n");
  193.      }
  194.      printf("\n");
  195.   }
  196. }
  197.  
  198. # PrintStatus
  199. #    Print some exit status information
  200. sub PrintStatus
  201. {
  202.   &Notice("overall exit status:%s, tests failed:%d, total tests executed:%d",
  203.        ($CD_ERRNO?"success":"failed"),$CD_ERRCNT,$CD_TESTCNT);
  204.  
  205.   &Log("overall exit status:%s, test failed:%d, total tests:%d",
  206.        ($CD_ERRNO?"success":"failed"),$CD_ERRCNT,$CD_TESTCNT)
  207. }
  208.  
  209. # ExitStatus
  210. #    Keep track of total fails, total tests and
  211. #    and the overall test code.
  212. #
  213. sub ExitStatus
  214. {
  215.   local ($code) = @_;
  216.   &LogEntry();
  217.   if ($code == $CD_FAILURE) {
  218.     $CD_ERRNO=$CD_FAILURE;
  219.     $CD_ERRCNT++;
  220.     &Debug("incrementing error counter %d",$CD_ERRCNT);
  221.   }
  222.   $CD_TESTCNT++;
  223. }
  224. # CheckMACSyntax
  225. #    Check that the MAC_address has the correct syntax
  226. #    E.g. a:b:c:d
  227. #
  228. sub CheckMACSyntax {
  229.   local ($address) = @_;
  230.   $address=~s/\"//g;
  231.   &Debug("Checking MAC address %s",$address);
  232.   if ($address =~ /\w+\:\w+\:\w+\:\w+\:\w+\:(\w+)/ ) {
  233.     return $CD_SUCCESS;
  234.   }
  235.   return $CD_FAILURE;
  236. }
  237.  
  238. # CheckIPSyntax
  239. #    Check that the IP_address hash the correct syntax
  240. #    E.g. a.b.c.d
  241. #
  242. sub CheckIPSyntax {
  243.   local ($address) = @_;
  244.   &LogEntry();
  245.   $address=~s/\"//g;
  246.   &Debug("Checking IP address %s",$address);
  247.   if ($address =~ /\d+\.\d+\.\d+\.(\d+)/ ) {
  248.     return $CD_SUCCESS;
  249.   }
  250.   return $CD_FAILURE;
  251. }
  252.  
  253. # CheckNetSyntax
  254. #    Check that the Network address is a valid hex number
  255. #   E.g. ffffff00
  256. #
  257. sub CheckNetSyntax {
  258.   local ($network) = @_;
  259.   &LogEntry();
  260.   $network=~s/\"//g;
  261.   if ($network =~ /^0x/) {
  262.     if ($network=hex($network)) {
  263.       if ($network > 0) {
  264.     return $CD_SUCCESS;
  265.       }
  266.     }
  267.   }
  268.   return $CD_FAILURE;
  269. }
  270.  
  271. # CheckInterface
  272. #    Check that the Interface exists on the machine
  273. #    PV 669915: The interface argument may be a command seperated list.
  274. #               But I don't want to change the overall methods like pulloff
  275. #               so I use index to search for the interface name in the
  276. #               supplied argument $interface.
  277. #
  278. sub CheckInterface{
  279.   local ($machine, $interface) = @_;
  280.   local ($if, $found, $junk);
  281.   local (@res);
  282.   local ($pos);
  283.   &LogEntry();
  284.  
  285.   @res=&rsh($machine,"/usr/etc/netstat -in");
  286.   if ($RSH_ERRNO != 0) {
  287.     &Failure("timeout talking with %s",$machine);
  288.     return $CD_FAILURE;
  289.   }
  290.   $found=0;
  291.   chomp(@res);
  292.  
  293.   foreach $if (@res) {
  294.     ($name, $junk)=split(' ',$if);
  295.     # For some reason, the parameters are quoted !!!
  296.     $interface=~s/\"//g;
  297.     $name=~s/\"//g;
  298.     $pos=-1;
  299.     while (($pos=index($interface,$name,$pos)) > -1) {
  300.        &Log("found interface name %s, in CDB interface list %s",$name,$interface);
  301.        $found =1;
  302.        $pos++;
  303.     }
  304.   }
  305.   if (!$found) {
  306.     return $CD_FAILURE;
  307.   }
  308.   return $CD_SUCCESS;
  309. }
  310.  
  311. # AutoLoad
  312. #    Dynamically look for resource perl scripts, if a match is
  313. #    the load the module/file.
  314. #
  315. sub AutoLoad
  316. {
  317.   local (@resources) = @_;
  318.   local (@fds, $fd);
  319.   local ($res,$file);
  320.   local ($found)=0;
  321.  
  322.   if(!opendir(HDL,$LibDiagsPath)) {
  323.     &Error(1,"failed to open %s",$LibDiagsPath);
  324.     return ($found);
  325.   }
  326.  
  327.   @fds=readdir(HDL);
  328.   closedir(HDL);
  329.   foreach $res (@resources) {
  330.     foreach $fd (@fds) {
  331.       $file="$res.pl";
  332.       if ($fd eq $file) {
  333.     &Debug("autoloading file %s/%s",$LibDiagsPath,$file);
  334.     require "$LibDiagsPath/$file";
  335.     $found=1;
  336.       }
  337.     }
  338.   }
  339.   return($found);
  340. }
  341.  
  342. # ExitGracefully
  343. #    Exit back to the command line with the specified exit code
  344. #
  345. sub ExitGracefully
  346. {
  347.   local($return_code) = @_;
  348.  
  349.   &CleanUp();
  350.   exit($return_code);
  351. }
  352.  
  353. # MakeTempFile
  354. #    make a temporary file at location $dir
  355. #
  356. sub MakeTempFile
  357. {
  358.   local($dir,$comment) = @_;
  359.   local($count,$file,$status,@call_info);
  360.  
  361.   if ($comment eq "") { $comment = (caller(1))[3]; }
  362.  
  363.   for ($count = 0; $count < 10000; $count++) {
  364.     $file = "$dir/libdiags$$_$count";
  365.     if (-e $file) { next; }
  366.  
  367.     $status = open(OUT,">$file");
  368.     if ($status == 0) { last; }
  369.     close(OUT);
  370.  
  371.     push(@files_to_clean,"$file:$comment");
  372.     return($file);
  373.   }
  374.  
  375.   &InternalError(__LINE__,__FILE__,
  376.          "MakeTempFile Can't Create Temp File In %s\n",$dir);
  377. }
  378.  
  379. # LogEntry
  380. #    Writes the caller entery point to the log file
  381. #
  382.  
  383. sub LogEntry
  384. {
  385.   local($pack, $file, $line, $subname, $hasargs, $wantarray);
  386.   ($pack, $file, $line, $subname, $hasargs, $wantarray)=caller(1);
  387.  
  388.   &Debug("Package:%s File:%s Line:%d SubName:%s Hasargs:%s Wantarray:%s",
  389.       $pack, $file, $line, $subname, $hasargs, $wantarray);
  390. }
  391.  
  392. # Log
  393. #    Writes a message to the FailSafe diagnostic file, at normal log level.
  394. #
  395. sub Log
  396. {
  397.   local($msg,@args) = @_;
  398.   local($buffer,$cmd);
  399.   local($package, $filename, $line);
  400.  
  401.   ($package, $filename, $line)=caller(1);
  402.  
  403.   $buffer=sprintf($msg,@args);
  404.   $cmd="/usr/cluster/bin/ha_cilog -l 1 -g diags -s diags \"$package:$filename:$line $buffer\"";
  405.   do_log($cmd,10);
  406. }
  407.  
  408. # Debug
  409. #    Writes a message to the FailSafe diagnostic file, at the debug level.
  410. #
  411. sub Debug
  412. {
  413.   local($msg,@args) = @_;
  414.   local($buffer,$cmd);
  415.   local($package, $filename, $line);
  416.  
  417.   ($package, $filename, $line)=caller(1);
  418.  
  419.   $buffer=sprintf($msg,@args);
  420.   $cmd="/usr/cluster/bin/ha_cilog -l 10 -g diags -s diags \"$package:$filename:$line $buffer\"";
  421.   do_log($cmd,10);
  422. }
  423.  
  424. # Notice
  425. #    Writes a message to standard output.
  426. #
  427. sub Notice
  428. {
  429.   local($msg,@args) = @_;
  430.   print STDERR &PrefixifyMultiLineString("Notice: ",
  431.                      sprintf($msg,@args));
  432.   print STDERR "\n";
  433. }
  434.  
  435. # Verbose
  436. #    Writes a message to standard output.
  437. #
  438. sub Verbose {
  439.   local($msg,@args) = @_;
  440.   if ($verbose) {
  441.     print STDERR &PrefixifyMultiLineString("",sprintf($msg,@args));
  442.     print STDERR "\n";
  443.   }
  444. }
  445.  
  446. # Verbose
  447. #    Writes a message to standard output.
  448. #
  449. sub Failure {
  450.   local($msg,@args) = @_;
  451.     print STDERR &PrefixifyMultiLineString("Failure: ",
  452.                        sprintf($msg,@args));
  453.     print STDERR "\n";
  454. }
  455.  
  456. # Suggest
  457. #    Writes a message to standard output.
  458. #
  459. sub Suggest
  460. {
  461.   local($msg,@args) = @_;
  462.   print STDERR &PrefixifyMultiLineString("Suggestion: ",
  463.                      sprintf($msg,@args));
  464.   print STDERR "\n";
  465. }
  466.  
  467. # Warning
  468. #    Writes a message to standard output.
  469. #
  470. sub Warning
  471. {
  472.   local($msg,@args) = @_;
  473.   print STDERR &PrefixifyMultiLineString("Warning: ",
  474.                      sprintf($msg,@args));
  475.   print STDERR "\n";
  476. }
  477.  
  478. # Success
  479. #    Writes a message to standard output.
  480. #
  481. sub Success
  482. {
  483.   local($msg,@args) = @_;
  484.   print STDERR &PrefixifyMultiLineString("Success: ",
  485.                      sprintf($msg,@args));
  486.   print STDERR "\n";
  487. }
  488.  
  489. # Status
  490. #    Writes a message to standard output.
  491. #
  492. sub Status
  493. {
  494.   local($msg,@args) = @_;
  495.   print STDERR &PrefixifyMultiLineString("Status: ",
  496.                      sprintf($msg,@args));
  497.   print STDERR "\n";
  498. }
  499.  
  500. # Error
  501. #    Writes a message to standard output, then calls ExitGracefully to exit
  502. #    back to the command line.
  503. #
  504. sub Error
  505. {
  506.   local($terminate,$msg,@args) = @_;
  507.   local($format,$errno,$errmsg);
  508.  
  509.   $errno = $!;
  510.   $errmsg = "$!";
  511.  
  512.   print STDERR &PrefixifyMultiLineString("Error: ",
  513.                      sprintf($msg,@args));
  514.   print STDERR "\n";
  515.   if ($terminate != 0) { &ExitGracefully($terminate); }
  516. }
  517.  
  518. # InternalError
  519. #    Writes a message to statdard output. Containg the file,line and errno
  520. #    of the failing command.
  521. #
  522. sub InternalError
  523. {
  524.   local($linenumber,$file,$msg,@args) = @_;
  525.   local($prefix,$errno,$errmsg);
  526.  
  527.   $errno = $!;
  528.   $errmsg = "$!";
  529.  
  530.   $prefix = sprintf("INTERNAL ERROR: (file %s, line %d, errno %d): ",
  531.             $file,$linenumber,$errno);
  532.   print STDERR &PrefixifyMultiLineString($prefix,
  533.                      sprintf($msg,@args));
  534.  
  535.   &CleanUp();
  536.   &ExitGracefully(1);
  537. }
  538.  
  539. sub OnTheSameNode
  540. {
  541.   local ($node) = @_;
  542.   local ($this_node);
  543.   local ($h_name1,$h_aliases1,$h_addrtype1,$h_len1,@h_addrs1);
  544.   local ($h_name2,$h_aliases2,$h_addrtype2,$h_len2,@h_addrs2);
  545.  
  546.   $this_host=`/sbin/uname -n`;
  547.   chop ($this_host);
  548.   ($h_name1,$h_aliases1,$h_addrtype1,$h_len1,@h_addrs1) = gethostbyname($NodeToHost{$node});
  549.   ($h_name2,$h_aliases2,$h_addrtype2,$h_len2,@h_addrs2) = gethostbyname($this_host);
  550.   if ($h_name2 eq $h_name1) {
  551.      return 1;
  552.   }
  553.   return 0;
  554. }
  555.  
  556. # ExecuteScript
  557. #    Executes a FailSafe script (start/stop/probe ...) on a remote
  558. #    machine.
  559. #
  560. sub ExecuteScript
  561. {
  562.   local ($machine, $resource, $type, $script) = @_;
  563.   local ($cmd);
  564.   local ($res,@output);
  565.   local ($retv,$this_host);
  566.   local ($name, $code);
  567.   $retv=0;
  568.  
  569.   &LogEntry();
  570.   # Create the script input file
  571.   $this_host=`/sbin/uname -n`;
  572.   chop($this_host);
  573.  
  574.   if (!&OnTheSameNode($machine)) {
  575.      &Notice("Resource Destructive tests can only be executed on the local host");
  576.      &Log("Can only execute the resource destructive tests on local host %s/%s",
  577.        $this_host, $NodeToHost{$machine});
  578.      return $CD_FAILURE;
  579.   }
  580.  
  581.   $cmd="/sbin/rm -f /tmp/testip /tmp/testop; /sbin/echo \"$resource\" > /tmp/testip";
  582.   @output=&do_cmd_with_timeout($cmd,60);
  583.   if ($RSH_ERRNO != 0 ) {
  584.     &Failure("failed to create test file on machine %s",$machine);
  585.     return 0;
  586.   }
  587.  
  588.   &Log("Executing $script script using resource $resource");
  589.   $cmd="$RESOURCE_PATH/$type/$script /tmp/testip /tmp/testop";
  590.   @output=&do_cmd_with_timeout($cmd,120);
  591.   if ($RSH_ERRNO != 0 ) {
  592.     &Failure("resource %s of resource_type %s failed on machine %s",$resource, $type, $machine);
  593.   }
  594.  
  595.   $cmd="cat /tmp/testop";
  596.   @output=&do_cmd_with_timeout($cmd,60);
  597.   if ( $RSH_ERRNO != 0 ) {
  598.     &Failure("failed to read script output file %s\n",$cmd);
  599.     return 0;
  600.   }
  601.  
  602.   foreach $res (@output) {
  603.     ($name, $code)=split(' ',$res);
  604.  
  605.     $code=hex($code);
  606.     &Log("returned code for resource %s script %s of type %s is %d",
  607.          $resource,$script,$type,$code);
  608.  
  609.     if (($script ne $HA_EXCLUSIVE) && ($code == $HA_SUCCESS)) {
  610.       &Debug("script \"%s\" returned \"%s\" for resource \"%s\"",
  611.            $script, "Success", $resource);
  612.  
  613.     } elsif (($script eq $HA_EXCLUSIVE) && ($code == $HA_NOT_RUNNING)) {
  614.       &Debug("script \"%s\" returned \"%s\" for resource \"%s\"",
  615.            $script,"Not Running",$resource);
  616.  
  617.     } elsif ($code == $HA_INVAL_ARGS) {
  618.       &Failure("script \"%s\" returned \"%s\" for resource \"%s\"",
  619.        $script,"Invalid Arguments",$resource);
  620.       &TailLogFile($machine,"script_$this_host");
  621.       return 0;
  622.  
  623.     } elsif (($script ne $HA_EXCLUSIVE) && ($code == $HA_CMD_FAILED)) {
  624.       &Failure("script \"%s\" returned \"%s\" for resource \"%s\"",
  625.        $script,"Command Failed",$resource);
  626.       &TailLogFile($machine,"script_$this_host");
  627.       return 0;
  628.  
  629.     } elsif (($script eq $HA_EXCLUSIVE) && ($code == $HA_RUNNING)) {
  630.       &Failure("script \"%s\" returned \"%s\" for resource \"%s\"",
  631.        $script,"Running",$resource);
  632.       &TailLogFile($machine,"script_$this_host");
  633.       return 0;
  634.  
  635.     } elsif ($code == $HA_NOTSUPPORTED) {
  636.       &Failure("script \"%s\" returned \"%s\" for resource \"%s\"",
  637.        $script,"Not Supported",$resource);
  638.       &TailLogFile($machine,"script_$this_host");
  639.       return 0;
  640.  
  641.     } elsif ($code == $HA_NOCFGINFO) {
  642.       &Failure("script \"%s\" returned \"%s\" for resource \"%s\"",
  643.        $script,"Bad config",$resource);
  644.       &TailLogFile($machine,"script_$this_host");
  645.       return 0;
  646.  
  647.     } else {
  648.       &Failure("Returned %d from %s script is undefined",
  649.        $code,$script);
  650.       return 0;
  651.     }
  652.   }
  653.   return 1;
  654. }
  655.  
  656. # GetResFromResType
  657. #    Returns the output from resourceEnumerate CLI. I.e. shows all the
  658. #    configured resources.
  659. #
  660. sub GetResFromResType {
  661.   local ($machine, $type) = @_;
  662.   local (@output,@tmp);
  663.   local ($cmd,$val,$junk,$rtype,$i);
  664.  
  665.   $cmd="$CLI_PATH/resourceEnumerate _CLUSTER=$Cluster _RESOURCE_TYPE=$type";
  666.   @tmp=&rsh($machine,$cmd);
  667.   if ($RSH_ERRNO != 0) {
  668.     return $NULL;
  669.   }
  670.  
  671.   $i=0;
  672.   foreach $line (@tmp) {
  673.     ($val, $junk, $rtype) = split(" ",$line);
  674.     if ($rtype eq $type) {
  675.        $output[$i]=$val;
  676.        $i++;
  677.     }
  678.   }
  679.   return (@output);
  680. }
  681.  
  682. sub GetResGroupType {
  683.   local ($line) = @_;
  684.   local ($a,$b);
  685.   ($a, $b) = split("type: ",$line);
  686.   $b=~s/[)]//g;
  687.   return $b;
  688. }
  689.  
  690. sub GetResGroupName {
  691.   local ($line) = @_;
  692.   local ($a,$b,$c);
  693.  
  694.   ($a,$b) = split("type:",$line);
  695.   $a=~s/[(]//g;
  696.   return $a;
  697. }
  698.  
  699. # GetGroupContents
  700. #    Returns an array of resource, and type
  701. #
  702. sub GetGroupContents {
  703.   local ($name)=@_;
  704.   local (@tmp,@output);
  705.   local ($cmd,$i,$cnt);
  706.  
  707.   $cmd="$CLI_PATH/resgroupEnumerateResources _CLUSTER=$Cluster _RESOURCE_GROUP=$name";
  708.   @tmp=&do_cmd_with_timeout($cmd,10);
  709.   $cnt=scalar(@tmp);
  710.   for ($i=0; $i < ($cnt-1); $i++) {
  711.     $tmp[$i+1]=~s/\t//g;
  712.     $output[$i]=$tmp[$i+1];
  713.   }
  714.   return (@output);
  715. }
  716.  
  717. # GetFailoverContents
  718. #    Returns an array of police information.
  719. #
  720. sub GetFailoverContents {
  721.   local ($policy)=@_;
  722.   local (@tmp,@output);
  723.   local ($cmd,$i,$cnt);
  724.   local ($ptmp);
  725.  
  726.   $cmd="$CLI_PATH/failoverQuery _FAILOVER_POLICY=$policy";
  727.   @tmp=&do_cmd_with_timeout($cmd,10);
  728.   $cnt=scalar(@tmp);
  729.   if (scalar(@tmp) < 2) {
  730.     &Warning("%s",$tmp[0]);
  731.     return (@output);
  732.   }
  733.   for ($i=0; $i < ($cnt-1); $i++) {
  734.     $tmp[$i+1]=~s/\t//g;
  735.     $output[$i]=$tmp[$i+1];
  736.   }
  737.   return (@output);
  738. }
  739.  
  740. # GetGroupFailoverPolicy
  741. #    Returns the failover policy for the resource group.
  742. #
  743. sub GetGroupFailoverPolicy {
  744.     local ($group)=@_;
  745.     local (@tmp, @output);
  746.     local ($cmd,$i,$cnt);
  747.     local ($ptmp);
  748.     local ($line);
  749.     local ($name, $val);
  750.  
  751.     $cmd="$CLI_PATH/resgroupQuery _RESOURCE_GROUP=$group _CLUSTER=$Cluster";
  752.     @tmp=&do_cmd_with_timeout($cmd,10);
  753.     foreach $line (@tmp) {
  754.         ($name,$policy)=split(': ',$line);
  755.         if ( $line =~ /Failover Policy/ ) {
  756.         &Debug("Resource group %s has failover policy %s",$group,$policy);
  757.         return $policy;
  758.         }
  759.     }
  760.     return $policy;
  761. }
  762.  
  763. #
  764. # GetMachinesinGroupAFD
  765. #    Returns the list of machines in resource group's failover
  766. #    policy AFD.
  767. sub GetMachinesinGroupAFD {
  768.     local ($group)=@_;
  769.     local (@machines);
  770.     local ($policy);
  771.  
  772.     # Get resource group failover policy
  773.     $policy=&GetGroupFailoverPolicy($group);
  774.     if (! ($policy)) {
  775.     &Failure("Resource group %s not present", $group);
  776.     return (@machines);
  777.     }
  778.  
  779.     @attribs=&GetFailoverContents($policy);
  780.     if (scalar(@attribs) < 2) {
  781.     &Failure("Resource group %s Policy %s is not defined", $group, $policy);
  782.     } else {
  783.     foreach $line (@attribs) {
  784.         ($key, $value) = split(":",$line);
  785.         if ($key=~/.*Initial AFD/) {
  786.         $afd=$value;
  787.         $afd=~ s/\s//;
  788.         @machines=split(" ", $afd);
  789.         }
  790.     }
  791.     }
  792.     return (@machines);
  793. }
  794.  
  795. # GetAllConfiguredGroups
  796. #    Returns the output from resgroupsEnumerate CLI. I.e show all the
  797. #    configured resource groups.
  798. #
  799. sub GetAllConfiguredGroups {
  800.   local (@tmp,@output);
  801.   local ($cmd,$i,$cnt);
  802.  
  803.   $cmd="$CLI_PATH/resgroupsEnumerate _CLUSTER=$Cluster";
  804.   @tmp=&do_cmd_with_timeout($cmd,10);
  805.   $cnt=scalar(@tmp);
  806.   for ($i=0; $i < ($cnt-1); $i++) {
  807.     $tmp[$i+1]=~s/.*\t//g;
  808.     $output[$i]=$tmp[$i+1];
  809.   }
  810.   return (@output);
  811. }
  812.  
  813. # GetAllConfiguredPolices
  814. #    Returns the output from failoverEnumerate CLI. I.e show all the
  815. #    configured failover policies.
  816. #
  817. sub GetAllConfiguredPolicies {
  818.   local (@tmp,@output);
  819.   local ($cmd,$i,$cnt);
  820.  
  821.   $cmd="$CLI_PATH/failoverEnumerate";
  822.   @tmp=&do_cmd_with_timeout($cmd,10);
  823.   $cnt=scalar(@tmp);
  824.   for ($i=0; $i < ($cnt-1); $i++) {
  825.     $tmp[$i+1]=~s/.*\t//g;
  826.     $output[$i]=$tmp[$i+1];
  827.   }
  828.   return (@output);
  829. }
  830.  
  831. # GetAllConfiguredResources
  832. #    Returns the output from restypeEnumerate CLI. I.e show all the configured
  833. #    resource types.
  834. #
  835. sub GetAllConfiguredResources {
  836.   local (@output);
  837.   local ($cmd);
  838.   $cmd="$CLI_PATH/restypeEnumerate _CLUSTER=$Cluster";
  839.   @output=&do_cmd_with_timeout($cmd,10);
  840.   return (@output);
  841. }
  842.  
  843. # GetResParameters
  844. #    Returns the output from resourceQuery CLI. I.e show all parameters for a particular
  845. #    resource.
  846. #
  847. sub GetResParameters {
  848.   local ($machine, $type, $name)= @_;
  849.   local (@output);
  850.   local ($cmd,$line,$pos);
  851.  
  852.   $cmd="$CLI_PATH/resourceQuery _CLUSTER=$Cluster _RESOURCE_TYPE=$type _RESOURCE=$name";
  853.   @output=&rsh($machine,$cmd);
  854.   if ($RSH_ERRNO != 0) {
  855.     return $NULL;
  856.   }
  857.   $pos=-1;
  858.   foreach $line (@output) {
  859.     if(($pos=strstr("Internal error",$line)) > -1) {
  860.       return -1;
  861.     }
  862.   }
  863.   return (@output);
  864. }
  865.  
  866. # GetResDependency
  867. #    Returns the output from resourceQuery CLI. I.e show all resource dependencies for
  868. #    a particular resource.
  869. #
  870. sub GetResDependency {
  871.   local ($machine,$type,$name)=@_;
  872.   local (@tmp,$cmd,@args);
  873.   local ($line,$ptr1,$ptr2);
  874.   local ($popluate,$found);
  875.  
  876.   $cmd="$CLI_PATH/resourceQuery _ALL=true _CLUSTER=$Cluster _RESOURCE_TYPE=$type _RESOURCE=$name";
  877.   @tmp=&rsh($machine,$cmd);
  878.   if ($RSH_ERRNO != 0) {
  879.     return $NULL;
  880.   }
  881.  
  882.   # Make some attempt to parse the dependency list.
  883.   $found=0;
  884.   $populate=0;
  885.   foreach $line (@tmp) {
  886.     ($ptr1, $ptr2) = split(" ",$line);
  887.     if ($populate) {
  888.       $args[$found]=$ptr1;
  889.       $args[++$found]=$ptr2;
  890.       $found++;
  891.     }
  892.     if ($line =~ /Resource dependencies/) {
  893.       $populate=1;
  894.     }
  895.   }
  896.  
  897.   if ($found == 0) {
  898.     return -1;
  899.   }
  900.   return (@args);
  901. }
  902.  
  903. # pulloff
  904. #    Looks for a particular resource parameter in the input list, and returns the
  905. #    assocaiated value.
  906. #
  907. sub pulloff {
  908.   local ($type, @list) =@_;
  909.   local ($name, $val);
  910.   local ($pair);
  911.  
  912.   foreach $pair (@list) {
  913.     ($name, $val)=split(" ",$pair);
  914.     if ($name eq $type) {
  915.       # remove all leading white space
  916.       $val=~s/^\s*(.*?)\s*/$1/;
  917.       return $val;
  918.     }
  919.   }
  920.    return "";
  921. }
  922.  
  923. # ExistResourcesOnDisk
  924. #    Returns the installed resource types.
  925. #
  926. sub ExistResourcesOnDisk{
  927.   local ($machine,$res) = @_;
  928.   local ($flag) = 0;
  929.   local (@output, $cmd,$pos);
  930.  
  931.   $cmd="$CLI_PATH/restypeInstallEnumerate _CLUSTER=$Cluster";
  932.   @output = &rsh($machine,$cmd);
  933.   if ($RSH_ERRNO != 0) {
  934.     return $NULL;
  935.   }
  936.   $flag=0;
  937.   $type=~s/\"//g;   # Remove any quotes
  938.  
  939.   $pos=-1;
  940.   foreach $type (@output) {
  941.     if (($pos=strstr($type,$res)) > -1) {
  942.       $flag=1;
  943.     }
  944.   }
  945.   return $flag;
  946. }
  947.  
  948. # ResourcesExists
  949. #    Uses the cdbutil CLI to build a name space tree.
  950. #
  951. sub ResourcesExists {
  952.     local ($machine) = @_;
  953.     local ($who);
  954.     local ($flag) = 0;
  955.  
  956.     $who = "#cluster#$Cluster#HA";
  957.     &get_tree($machine_name, $who);
  958.     for ($i= 0; $i <= $No_of_children{$who}; $i++) {
  959.       if ($child{$who, $i} eq "resources") {
  960.     if ($value_me{$who, $child{$who, $i}, $i} eq '<tree>') {
  961.       $flag = 1;
  962.     }
  963.       }
  964.     }
  965.     return ($flag);
  966. }
  967.  
  968. # GetAllMachines
  969. #    Returns all configured machines.
  970. #
  971. sub GetAllMachines {
  972.   local (@output,@tmp);
  973.   local ($cmd,$i,$populate,$ptr1,$ptr2);
  974.   local ($line);
  975.  
  976.   $cmd="$CLI_PATH/machineEnumerate";
  977.   @tmp=&do_cmd_with_timeout($cmd,10);
  978.   chomp(@tmp);
  979.  
  980.   # Make some attempt to parse the dependency list.
  981.   $i=0;
  982.   $populate=0;
  983.   foreach $line (@tmp) {
  984.     if ($populate) {
  985.     $line =~ s/\s//;
  986.     if ($line ne "") {
  987.         $output[$i]=$line;
  988.         $i++;
  989.     }
  990.      }
  991.      if ($line=~/.*Machine*/) {
  992.     $populate=1;
  993.      }
  994.   }
  995.   # Issue an error since there are no machines configured
  996.   if (scalar(@output) < 1) {
  997.      &Failure("No machines are configured: %s",$tmp[0]);
  998.   }
  999.   return (@output);
  1000. }
  1001.  
  1002. # ExistResourceInCDB
  1003. #    Returns 1 if the resource exists, else -1 if it dosesn't.
  1004. #
  1005. sub ExistResourceInCDB {
  1006.   local ($machine, $restype) = @_;
  1007.   local ($Output, $cmd,$line,$pos);
  1008.   local ($flag) = 0;
  1009.  
  1010.   $cmd="$CLI_PATH/restypeEnumerate _CLUSTER=$Cluster";
  1011.   @output=&rsh($machine,$cmd);
  1012.   if ($RSH_ERRNO != 0) {
  1013.     return $NULL;
  1014.   }
  1015.   $restype=~s/\"//g;   # Remove any quotes
  1016.  
  1017.   $pos=-1;
  1018.   foreach $line (@output) {
  1019.     if (($pos=strstr($line,$restype)) > -1) {
  1020.       $flag=1;
  1021.     }
  1022.   }
  1023.   return $flag;
  1024. }
  1025.  
  1026. # PrefixifyMultiLineString
  1027. #    Adds a user defines prefix to the $string. Returns the modified string
  1028. #
  1029. sub PrefixifyMultiLineString
  1030. {
  1031.   local($prefix,$string) = @_;
  1032.   local($ending_nl,$new_string,$line,@lines);
  1033.  
  1034.   $ending_nl = (substr($string,length($string) - 1,1) eq "\n");
  1035.   if ($ending_nl) { chop($string); }
  1036.  
  1037.   $new_string = "";
  1038.   @lines = split("\n",$string . "\n*");
  1039.   pop(@lines);
  1040.   foreach $line (@lines)
  1041.     {
  1042.       $new_string = $new_string . $prefix . $line . "\n";
  1043.     }
  1044.   if (! $ending_nl) { chop($new_string); }
  1045.  
  1046.   return($new_string);
  1047. }
  1048.  
  1049. # CheckProc
  1050. #    Returns 1 if the process exists on machine, else 0;
  1051. #
  1052. sub CheckProc {
  1053.   local ($machine, $proc) = @_;
  1054.   local ($cmd, @output, $linem, $found, $pos);
  1055.  
  1056.   $cmd="/sbin/ps -e | grep $proc";
  1057.   @output=&rsh($machine,$cmd,);
  1058.   if ($RSH_ERRNO != 0) {
  1059.     return $NULL;
  1060.   }
  1061.   $pos=1;
  1062.   $found=0;
  1063.   foreach $line (@output) {
  1064.     if ( ($pos=strstr($type,$res)) > -1) {
  1065.       $found=1;
  1066.     }
  1067.   }
  1068.   return $found;
  1069. }
  1070.  
  1071. # GetMachineInfo
  1072. #    Returns the machine parameters for a machine.
  1073. #
  1074. sub GetMachineInfo {
  1075.   local ($machine) = @_;
  1076.   local (@output, $cmd);
  1077.  
  1078.   $cmd="$CLI_PATH/machineQuery _NUM_MACHINES=1 _MACHINE_0=$machine";
  1079.   @output=&do_cmd_with_timeout($cmd,10);
  1080.   return @output;
  1081.  
  1082. }
  1083.  
  1084. # GetMachineParam
  1085. #    Returns the value of a machine parameter.
  1086. #
  1087. sub GetMachineParam {
  1088.   local ($str, @list) = @_;
  1089.   local ($key, $val);
  1090.   local ($line);
  1091.  
  1092.   foreach $line (@list) {
  1093.     ($key, $val)=split(": ",$line);
  1094.     $key=substr($key,0,length($str));
  1095.     if ( $key eq $str ) {
  1096.       # found the string line
  1097.       return $val;
  1098.     }
  1099.   }
  1100.    return -1;
  1101. }
  1102.  
  1103. # The rest of these fuctions have been taken from Array Services
  1104. # Perl library.
  1105. #
  1106.  
  1107. sub get_ip_address {
  1108.   local ($nxt_host, $timeout) = @_;
  1109.   local ($h_name, $h_aliases, $h_addrtype, $h_len, @h_addrs);
  1110.   local ($this_cmd, $first, $second, $third, $fourth, $old_sig);
  1111.  
  1112.   # so that handler can kill it.
  1113.   $this_cmd = "gethostbyname ($nxt_host)";
  1114.  
  1115.   # Can not use subroutine <do_cmd_with_timeout> since that is
  1116.   # for system calls etc. Will just do the timeout here itself.
  1117.   $old_sig = $SIG{'ALRM'};
  1118.   $SIG{'ALRM'} = 'lanarray_alrm_handler';
  1119.  
  1120.   # Enable timeout.
  1121.   alarm ($timeout);
  1122.   ($h_name,$h_aliases,$h_addrtype,$h_len,@h_addrs)=gethostbyname($nxt_host);
  1123.   # Disable timeout.
  1124.   alarm (0);
  1125.   $SIG{'ALRM'} = $old_sig;
  1126.  
  1127.   if (@h_addrs) {
  1128.     # Got at least one IP address. Read the first one.
  1129.     if (scalar(@h_addrs)) {
  1130.       &Verbose("Number of IP addresses obtained for <%s> = %s",
  1131.            $nxt_host,scalar(@h_addrs));
  1132.     }
  1133.     ($first, $second, $third, $fourth) = unpack('C4', $h_addrs[0]);
  1134.     $ip_address{$nxt_host}=$first.".".$second.".".$third.".".$fourth;
  1135.     if ($ip_address{$nxt_host}) {
  1136.       &Verbose("\tThe first IP address for <%s> = %s",
  1137.            $nxt_host,  $ip_address{$nxt_host});
  1138.     }
  1139.   }else{
  1140.     # IP address(es) not filled in. Error.
  1141.     &Error(0,"Can't Find IP Address For Node '$nxt_host'\n");
  1142.     &Suggest("(1) Check /etc/resolv.conf (see 'man resolv.conf')\n" .
  1143.          "(2) Verify Host Tables, If Using\n" .
  1144.          "(3) Verify NIS, If Using\n" .
  1145.          "(4) Verify BIND, If Using\n");
  1146.     return $CD_FAILURE;
  1147.    }
  1148.   return $CD_SUCCESS;
  1149. }
  1150.  
  1151. ####################################################################
  1152. #                   SUBROUTINE PING_HOST_CHECK                     #
  1153. # Check to see if the host given is pingable.                      #
  1154. ####################################################################
  1155. sub ping_host_check {
  1156.    local ($machine, $remote_host, $timeout) = @_;
  1157.    local ($ping_cmd, @ping_out);
  1158.    local ($found)=0;
  1159.  
  1160.    $ping_cmd = "/usr/bsd/rsh $machine -n /usr/etc/ping -c1 $remote_host";
  1161.    @ping_out = &do_cmd_with_timeout($ping_cmd, $timeout);
  1162.    if (scalar(@ping_out) > 1) {
  1163.      foreach $line (@ping_out) {
  1164.        if ($line =~/.*100.*.packet loss.*/) {
  1165.      $found=1;
  1166.        }
  1167.      }
  1168.    }
  1169.    if (($found) || (scalar(@ping_out) < 1)) {
  1170.      &Error(0,"Ping Failed To Node '%s'\n",$remote_host);
  1171.      &Suggest("(1) Ensure Node '$remote_host' Is Up\n" .
  1172.           "(2) Ensure Node '$remote_host' Can ping Itself\n" .
  1173.           "(3) Ensure Node '$remote_host' Connected To Network");
  1174.      return 0;
  1175.    }
  1176.    return 1;
  1177. } # end of "sub ping_host_check"
  1178.  
  1179. ####################################################################
  1180. #                  SUBROUTINE OTHERS_RSH_CHECK                     #
  1181. # Check to see if I can guest rsh to the host given.               #
  1182. # (use command "date").                                            #
  1183. ####################################################################
  1184. sub others_rsh_check {
  1185.    local ($remote_host, $timeout) = @_;
  1186.    local ($rsh_cmd, $rsh_out);
  1187.  
  1188.    $rsh_cmd = "/usr/bsd/rsh $remote_host -l guest -n date";
  1189.    $rsh_out = &do_cmd_with_timeout($rsh_cmd, $timeout);
  1190.    if ($? == 0) {
  1191.        if ($Verbose) {
  1192.        print "Output from rsh:\n$rsh_out\n";
  1193.        print "Successful in guest rsh'ing to <$remote_host>.\n\n";
  1194.        }
  1195.        &Notice("Successful 'guest rsh' To '$remote_host'\n");
  1196.    }
  1197.    else {
  1198.       # $? != 0; rsh failed.
  1199.       &lan_warning_msg_print;
  1200.       if ($Verbose) {
  1201.       &Warning("Unable to rsh to <$remote_host> as guest.\nRsh failed with output:\n$rsh_out\n");
  1202.       }
  1203.       &Warning("Cannot Perform 'guest rsh' To Node '$remote_host'\n");
  1204.       &Suggest("Fix 'guest rsh' Unless Intentionally Restricted\n");
  1205.    }
  1206. } # end of "sub others_rsh_check"
  1207.  
  1208. ####################################################################
  1209. #                SUBROUTINE TTCP_ALL_CHECK                         #
  1210. # Test ttcp between local and given remote machine for the primary #
  1211. # interface.                                                       #
  1212. ####################################################################
  1213. sub ttcp_all_check {
  1214.    local ($remote_host, $timeout) = @_;
  1215.    local ($ip_name, $ttcp_options, $arbit_num, $fourth, $port_num);
  1216.  
  1217. #FIX: test all network interfaces other than hippi?
  1218.  
  1219.    #################################################################
  1220.    # Primary interface test. Use non-default values for portnum,   #
  1221.    # length of buffer etc. ttcp_check args:                        #
  1222.    #        remote hostname,                                       #
  1223.    #        ip_name (same as above),                               #
  1224.    #        timeout,                                               #
  1225.    #        expected perf (KB/s) - 500 KB/s                        #
  1226.    #        other ttcp options (if non-default) - -p port -n 1024  #
  1227.    #################################################################
  1228.    $ip_name = $remote_host;
  1229.  
  1230.    #################################################################
  1231.    # Need a "unique" port number for this ttcp session to send/    #
  1232.    # listen to. Make it equal to 5001 + fourth field of ip address #
  1233.    # + $$ (or modulo, if $$ > 10000).                              #
  1234.    #################################################################
  1235.    if ($ip_address{$remote_host} =~ /\d+\.\d+\.\d+\.(\d+)/ ) {
  1236.       $fourth = $1;
  1237.    }
  1238.    else {
  1239.       &lan_error_msg_print;
  1240.       &InternalError(__LINE__,__FILE__,"Unexpected IP Address Format.\n");
  1241.    }
  1242.  
  1243.    $arbit_num = $$;
  1244.    if ($arbit_num > 10000) {
  1245.       $arbit_num = ($arbit_num)%10000;
  1246.    }
  1247.    $port_num = 5001 + $fourth + $arbit_num;
  1248.  
  1249.    $ttcp_options = " -p $port_num -n 1024";
  1250.    &ttcp_check($remote_host, $ip_name, $timeout, 500, $ttcp_options);
  1251. } # end of "sub ttcp_all_check"
  1252.  
  1253. ####################################################################
  1254. #                SUBROUTINE TTCP_CHECK                             #
  1255. # Test ttcp between local and given remote ip_name.                #
  1256. ####################################################################
  1257. sub ttcp_check {
  1258.  
  1259.    local ($remote_host, $ip_name, $timeout, $exp_perf, $ttcp_options) = @_;
  1260.    local ($ttcp_cmd_string, $ttcp_dest_cmd, $ttcp_dest_out, $ttcp_file);
  1261.    local ($ttcp_src_cmd, $ttcp_src_out, $thruput_number, $file_out);
  1262.    local ($ttcp_recv_ready, $ttcp_rcvr_pid, $user_name, $port_option);
  1263.  
  1264.    $user_name = (getpwuid($>))[0];
  1265.  
  1266.    # The file to store the output and error from ttcp-rcver.
  1267.    $ttcp_file = "/usr/tmp/lantest$$_0";
  1268.  
  1269.    #################################################################
  1270.    # The essential steps:                                          #
  1271.    # (i) Start ttcp in receive mode at the remote end in bg.       #
  1272.    #     (rsh remote_host '/bin/sh -c \"/usr/etc/ttcp -r -s        #
  1273.    #      1>ttcp_file 2>&1 & \"') etc                              #
  1274.    #     /bin/sh because of user's default shell being csh etc...  #
  1275.    #(ii) Start ttcp in transmit mode at this end.                  #
  1276.    #     (/usr/etc/ttcp -t -s remote_host) etc                     #
  1277.    #################################################################
  1278.  
  1279.    # The basic ttcp string with its options.
  1280.    $ttcp_cmd_string = "/usr/etc/ttcp -s";
  1281.    # Now add the options passed in.
  1282.    $ttcp_cmd_string = $ttcp_cmd_string . $ttcp_options;
  1283.  
  1284.    #################################################################
  1285.    # Redirect the output of ttcp to $ttcp_file on remote host.     #
  1286.    # Will look at the file to make sure the ttcp-rcver is set up   #
  1287.    # before starting the ttcp-tmitter. Also this file will contain #
  1288.    # error msgs, if ttcp failed on the receiver end.               #
  1289.    #################################################################
  1290.  
  1291.    $ttcp_dest_cmd = "/usr/bsd/rsh $remote_host -n '/bin/sh -c \"$ttcp_cmd_string -r 1>$ttcp_file 2>&1 & \"'";
  1292.    $ttcp_dest_out = &do_cmd_with_timeout($ttcp_dest_cmd, $timeout);
  1293.  
  1294.    if (($? != 0) || ($ttcp_dest_out)) {
  1295.       &lan_error_msg_print;
  1296.       &Error(1,"Remote Shell On '$remote_host' Failed With Output:\n$ttcp_dest_out\n");
  1297.    }
  1298.  
  1299.    # Check to see if ttcp is running on remote host. Look for this port no.
  1300.    if ($ttcp_options =~ /(-p\s+\d+)\s*/) {
  1301.       $port_option = $1;
  1302.    }
  1303.    else {
  1304.       $port_option = '';
  1305.    }
  1306.    $ttcp_rcvr_pid =
  1307.        &remote_ttcp_process($remote_host, $user_name, $timeout, $port_option);
  1308.    if (!$ttcp_rcvr_pid) {
  1309.       # Our ttcp not running on remote node. Error.
  1310.       &lan_error_msg_print;
  1311.       # Check the file for error msg.
  1312.       &Error(0,"Receiver 'ttcp' Process Not Running On '$remote_host'\n");
  1313.       $file_out = &get_remote_file ($remote_host, $ttcp_file, $timeout);
  1314.       if ($file_out !~ /^UX:cat:\s*ERROR:/) {
  1315.          # File exists. Clean it up before dying.
  1316.      &Error(0,"The Output From 'ttcp' Was:\n$file_out\n");
  1317.          &clean_up_ttcp_file ($remote_host, $timeout, $ttcp_file);
  1318.       }
  1319.       &ExitGracefully(1);
  1320.    }
  1321.  
  1322.    #################################################################
  1323.    # ttcp-r running. Check ttcp_file to make sure it is indeed our #
  1324.    # ttcp-r (the one that we just tried to start) & has opened a   #
  1325.    # socket etc. Try to get that file 10 (???) times with a sec    #
  1326.    # interval between each get. Error if cannot access file.       #
  1327.    #################################################################
  1328.    $ttcp_recv_ready = 0;
  1329.    for (1 .. 10) {
  1330.       $file_out = &get_remote_file ($remote_host, $ttcp_file, $timeout);
  1331.       if ($file_out !~ /^UX:cat:\s*ERROR:/) {
  1332.          ###########################################################
  1333.          # File exists. Check its contents. If there was some error#
  1334.          # in starting the ttcp recieiver, the error msg will be   #
  1335.          # in this file and it will have the "errno" keyword set.  #
  1336.          # And you got here becoz ANOTHER ttcp process was running #
  1337.          # under your user id. If this file does not have an error #
  1338.          # condition keyword and if our ttcp-recvr process is run- #
  1339.          # ning, this file should have a line with "socket" in it. #
  1340.          ###########################################################
  1341.          if ($file_out =~ /errno/) {
  1342.                &Error(0, "Receiver 'ttcp' Process Not Running On '$remote_host'\n");
  1343.                &Error(0,"The Output From 'ttcp' Was:\n$file_out\n");
  1344.                &clean_up_ttcp_file ($remote_host, $timeout, $ttcp_file);
  1345.                &ExitGracefully(1);
  1346.          }
  1347.          elsif ($file_out =~ /socket/) {
  1348.                $ttcp_recv_ready = 1;
  1349.                last;
  1350.          }
  1351.       }
  1352.       sleep (1);
  1353.    } # for (1 .. 10)
  1354.  
  1355.    if ($ttcp_recv_ready == 0) {
  1356.       # Die after cleaning up ttcp-r and ttcp_file on the remote host.
  1357.       &clean_up_ttcp_recvr ($remote_host, $timeout, $ttcp_pid);
  1358.       &clean_up_ttcp_file ($remote_host, $timeout, $ttcp_file);
  1359.       &lan_error_msg_print;
  1360.       &Error(1,"Time Out Starting Receiver 'ttcp'\n");
  1361.    }
  1362.  
  1363.    $ttcp_timeout = 30;  # Shouldn't this be even greater than 30?
  1364.    $ttcp_src_cmd = "$ttcp_cmd_string -t $ip_name";
  1365.    $ttcp_src_out = &do_cmd_with_timeout($ttcp_src_cmd, $ttcp_timeout);
  1366.  
  1367.    if ($? == 0) {
  1368.       # Get the thruput number out from the 5th line.
  1369.       if ($ttcp_src_out =~  m&=\s+(\d+\.\d+)\s+KB/sec&) {
  1370.          $thruput_number = $1;
  1371.      &Notice("Bandwidth To '$ip_name' = %.1f KB/sec\n",
  1372.          $thruput_number);
  1373.          if ($thruput_number < $exp_perf) {
  1374.             &lan_warning_msg_print;
  1375.         &Warning("Obtaining Less Than %.1f KB/sec To '%s'\n",
  1376.              $exp_perf,$ip_name);
  1377.          }
  1378.       }
  1379.       else {
  1380.       &InternalError(__LINE__,__FILE__, "Unexpected Output From ttcp.\n");
  1381.       }
  1382.       &clean_up_ttcp_file ($remote_host, $timeout, $ttcp_file);
  1383.    }
  1384.    else {
  1385.       &clean_up_ttcp_file ($remote_host, $timeout, $ttcp_file);
  1386.       &lan_error_msg_print;
  1387.       &Error(1,"Program 'ttcp' Failed: $ttcp_src_out\n");
  1388.    }
  1389. } # end of "sub ttcp_check"
  1390.  
  1391. ####################################################################
  1392. #                SUBROUTINE REMOTE_TTCP_PROCESS                    #
  1393. # Checks to see if there is a ttcp process with the given options  #
  1394. # is running on the remote host.                                   #
  1395. # Return value = pid if yes,                                       #
  1396. #              = 0   if not.                                       #
  1397. ####################################################################
  1398. sub remote_ttcp_process {
  1399.    local ($remote_host, $myid, $timeout, $ttcp_options) = @_;
  1400.    local ($ttcp_ps_cmd, $ttcp_ps_out, @ttcp_ps_list, $ttcp_ps_line);
  1401.    local ($ttcp_pid, @ttcp_fields);
  1402.  
  1403.    $ttcp_ps_cmd = "/usr/bsd/rsh $remote_host -n /sbin/ps -ef";
  1404.    $ttcp_ps_out = &do_cmd_with_timeout ($ttcp_ps_cmd, $timeout);
  1405.  
  1406.    if ($? == 0) {
  1407.       @ttcp_ps_list = grep((/ttcp/ && !/grep\s*ttcp/ && /$ttcp_options/),
  1408.                split(/\n/, $ttcp_ps_out));
  1409.       if (@ttcp_ps_list) {
  1410.          $ttcp_pid = 0;
  1411.          # ttcp is running on remote host.
  1412.          foreach $ttcp_ps_line (@ttcp_ps_list) {
  1413.             # If this is for your user id, get the pid.
  1414.             @ttcp_fields = split (' ', $ttcp_ps_line);
  1415.             if ($ttcp_fields[0] eq $myid) {
  1416.                $ttcp_pid = $ttcp_fields[1];
  1417.                last;
  1418.         }
  1419.      }
  1420.          return($ttcp_pid);
  1421.       }
  1422.       else {
  1423.       return(0);
  1424.       }
  1425.    }
  1426.    else {
  1427.        &lan_error_msg_print;
  1428.        &Error(1,"Remote Command '$ttcp_ps_cmd' Failed With Output:\n$ttcp_ps_out");
  1429.    }
  1430. } # end of "sub remote_ttcp_process"
  1431.  
  1432. ####################################################################
  1433. #               SUBROUTINE CLEAN_UP_TTCP_RECVR                     #
  1434. ####################################################################
  1435. sub clean_up_ttcp_recvr {
  1436.    local ($remote_host, $timeout, $ttcp_pid) = @_;
  1437.    local ($kill_cmd, $kill_out);
  1438.  
  1439. #  print "Cleaning up the ttcp-r process created for ttcp test.\n";
  1440.    $kill_cmd = "/usr/bsd/rsh $remote_host -n /usr/bin/kill $ttcp_pid";
  1441.    $kill_out = &do_cmd_with_timeout ($kill_cmd, $timeout);
  1442.  
  1443.    if ($? != 0) {
  1444.       &lan_error_msg_print;
  1445.       &Error(1,"Remote Command '$kill_cmd' Failed With Output:\n$kill_out");
  1446.    }
  1447.  
  1448. } # end of "sub clean_up_ttcp_recvr"
  1449.  
  1450. ####################################################################
  1451. #               SUBROUTINE CLEAN_UP_TTCP_FILE                      #
  1452. ####################################################################
  1453. sub clean_up_ttcp_file {
  1454.    local ($remote_host, $timeout, $ttcp_file) = @_;
  1455.    local ($rm_cmd, $rm_out);
  1456.  
  1457.    # &Notice ("Deleting Temp File '$ttcp_file'\n");
  1458.    $rm_cmd = "/usr/bsd/rsh $remote_host -n /sbin/rm $ttcp_file";
  1459.    $rm_out = &do_cmd_with_timeout ($rm_cmd, $timeout);
  1460.  
  1461.    if ($? != 0) {
  1462.       &lan_error_msg_print;
  1463.       &Error(1,"Remote Command '$rm_cmd' Failed With Output:\n$rm_out");
  1464.    }
  1465.  
  1466. } # end of "sub clean_up_ttcp_file"
  1467.  
  1468. ####################################################################
  1469. #                   SUBROUTINE MALLICK_CHECK                       #
  1470. # Check whether on the given host: (as per Mallick)                #
  1471. #     (i) nfs is installed,                                        #
  1472. #    (ii) network, nfs & automount/autofs/amd chkcfg'ed to <on>,   #
  1473. #   (iii) automounter/autofs/amd is running on the remote host,    #
  1474. #    (iv) /etc/exports has at least one line in it, and            #
  1475. #     (v) can cd to /hosts/$remote_host/{dirs mounted}             #
  1476. #     Added amd as automounter alternative (NASA Ames) - 10/19/95  #
  1477. #     Added autofs as automounter alternative - 03/13/96, IP       #
  1478. ####################################################################
  1479. sub mallick_check {
  1480.    local ($remote_host, $timeout) = @_;
  1481.    local ($remote_automounter);
  1482.  
  1483.    # Do a versions on nfs.
  1484.    &nfs_check($remote_host, $timeout);
  1485.  
  1486.    # Test chkconfig flags for network, nfs and automount/autofs/amd.
  1487.    $remote_automounter = &chkcfg_check($remote_host, $timeout);
  1488.    &Notice("Host '$remote_host' is using automounter '$remote_automounter'\n");
  1489.  
  1490.    # Test whether automounter running or not.
  1491.    &automounter_check($remote_host, $remote_automounter, $timeout);
  1492.  
  1493.    # Get /etc/exports from given host & test cd'ing to its first exp. dir.
  1494.    &exports_check($remote_host, $remote_automounter, $timeout);
  1495.  
  1496. } # end of "sub mallick_check"
  1497.  
  1498. #####################################################################
  1499. #                       SUBROUTINE NFS_CHECK                        #
  1500. # Check whether NFS installed on the remote host.                   #
  1501. #####################################################################
  1502. sub nfs_check {
  1503.    local ($remote_host, $timeout) = @_;
  1504.    local ($versions_cmd, $versions_out, @nfs_lines);
  1505.  
  1506.    # Do a versions on nfs.
  1507.    &Notice("Checking nfs Version On '$remote_host'\n");
  1508.  
  1509.    $versions_cmd = "/usr/bsd/rsh $remote_host -n /usr/sbin/versions nfs";
  1510.    $versions_out = &do_cmd_with_timeout ($versions_cmd, $timeout);
  1511.  
  1512.    if ($? == 0) {
  1513.       # Check if any nfs lines.
  1514.       @nfs_lines = grep (/nfs/, split(/\n/, $versions_out));
  1515.       if (@nfs_lines) {
  1516.          # Check for no 'R' in the first column (first letter?) of each line.
  1517.          foreach (@nfs_lines) {
  1518.             if (/^\s*R/) {
  1519.                &lan_error_msg_print;
  1520.            &Error(0,"NFS Removed From '$remote_host'\n");
  1521.            if ($Verbose)
  1522.            {
  1523.            &Error(0,"Output of versions:\n@nfs_lines\nQuitting ...\n");
  1524.            }
  1525.            &ExitGracefully(1);
  1526.             }
  1527.          }
  1528.          # Here because no 'R' in first column.
  1529.      if ($Verbose) { &Notice("Output from versions:\n@nfs_lines\n"); }
  1530.          &Notice("NFS Installed On '$remote_host'\n");
  1531.       }
  1532.       else {
  1533.          &lan_error_msg_print;
  1534.          &Error(1,"NFS Not Installed On '$remote_host'\n");
  1535.       }
  1536.    }
  1537.    else {
  1538.       # $? != 0; rsh failed.
  1539.       &lan_error_msg_print;
  1540.       if ($Verbose) { &Error(0,"Rsh failed with output:\n$versions_out\n"); }
  1541.       &Error(1,"Couldn't Run '$versions_cmd'\n");
  1542.    }
  1543. } # end of "sub nfs_check"
  1544.  
  1545. #####################################################################
  1546. #                    SUBROUTINE CHKCFG_CHECK                        #
  1547. # Check the config. status of the network, nfs & automounter flags  #
  1548. # on a remote machine and return the automounter in use there.        #
  1549. #####################################################################
  1550. sub chkcfg_check {
  1551.    local ($remote_host, $timeout) = @_;
  1552.    local ($flag, $chk_cmd, $chk_out, @chk_lines, @chk_fields);
  1553.    local ($num_flags_correct, $key_field, $val_field);
  1554.    local ($remote_automounter);
  1555.  
  1556.    # Do a chkconfig.
  1557.    &Notice("Verifying NFS Configuration Flags\n");
  1558.  
  1559.    $num_flags_correct = 0;
  1560.  
  1561.    $chk_cmd = "/usr/bsd/rsh $remote_host -n /sbin/chkconfig";
  1562.    $chk_out = &do_cmd_with_timeout($chk_cmd, $timeout);
  1563.  
  1564.    if ($? == 0) {
  1565.        # Grep out the lines with nfs and network.
  1566.        foreach $flag ("network", "nfs")
  1567.        {
  1568.        @chk_lines = grep (/$flag\s+\S+/, split(/\n/, $chk_out));
  1569.        if (@chk_lines < 1)
  1570.        {
  1571.            &Error(0,"Configuration Flag '$flag' Not Set For '$remote_host'\n");
  1572.            &Suggest("Do 'chkconfig $flag on' For '$remote_host'\n");
  1573.            next;
  1574.        }
  1575.        elsif (@chk_lines > 1)
  1576.        {
  1577.            &Warning("Multiple '$flag' Flags From 'chkconfig' For '$remote_host'\n");
  1578.        }
  1579.  
  1580.        ($key_field, $val_field) = ($chk_lines[0] =~ /\s*(\S+)\s+(\S+)/);
  1581.  
  1582.        if ($val_field eq 'on')
  1583.        {
  1584.            if ($Verbose) { &Notice("Flag '$key_field' Correctly Configured 'on' For '$remote_host'\n"); }
  1585.            ++ $num_flags_correct;
  1586.        }
  1587.        elsif ($val_field eq 'off')
  1588.        {
  1589.            &lan_error_msg_print;
  1590.            &Error(0,"Flag '$key_field' Incorrectly Configured 'off' For '$remote_host'\n");
  1591.            &Suggest("Do 'chkconfig $key_field on'\n");
  1592.        }
  1593.        elsif ($val_field eq '')
  1594.        {
  1595.            &lan_error_msg_print;
  1596.            &Error(0,"Flag '$key_field' Not Set For '$remote_host'\n");
  1597.            &Suggest("Do 'chkconfig $key_field on'\n");
  1598.        }
  1599.        else
  1600.        {
  1601.            &lan_error_msg_print;
  1602.            &Error(0,"Flag '$key_field' Has Bogus State '$val_field' For '$remote_host'\n");
  1603.            &Suggest("Do 'chkconfig $key_field on'\n");
  1604.        }
  1605.        }
  1606.  
  1607.        # Make sure at least one automounter is available
  1608.        $remote_automounter = "";
  1609.        foreach $flag ("automount", "autofs", "amd")
  1610.        {
  1611.        @chk_lines = grep (/$flag\s+\S+/, split(/\n/, $chk_out));
  1612.        if (@chk_lines < 1)
  1613.        {
  1614.            next;
  1615.        }
  1616.        elsif (@chk_lines > 1)
  1617.        {
  1618.            &Warning("Multiple '$flag' Flags From 'chkconfig' For '$remote_host'\n");
  1619.        }
  1620.  
  1621.        ($key_field, $val_field) = ($chk_lines[0] =~ /\s*(\S+)\s+(\S+)/);
  1622.  
  1623.        if ($val_field eq 'on')
  1624.        {
  1625.            if ($Verbose) {
  1626.            &Notice("Flag '$key_field' Configured 'on' For '$remote_host'\n");
  1627.            }
  1628.            $remote_automounter = $key_field;
  1629.            ++$num_flags_correct;
  1630.            last;
  1631.        }
  1632.        elsif ($Verbose) {
  1633.            &Notice("Flag '$key_field' Is Not Configured 'on' For '$remote_host'\n");
  1634.        }
  1635.        }
  1636.  
  1637.        if ("$remote_automounter" eq "") {
  1638.        &Error(0, "No Automounter Installed On '$remote_host'\n");
  1639.        &Suggest("Do 'chkconfig autofs on' or 'chkconfig automount on'\n");
  1640.        }
  1641.  
  1642.        # Summarize our results
  1643.        if ($num_flags_correct == 3)
  1644.        {
  1645.        &Notice("Network/NFS Configuration Flags Are Correct For '$remote_host'\n");
  1646.        }
  1647.        else
  1648.        {
  1649.        &Error(0,"Only %d Of 3 Network/NFS Configuration Flags Are Correct For '$remote_host'\n",
  1650.           $num_flags_correct);
  1651.        &Suggest("Follow Suggestions Above\n");
  1652.        &ExitGracefully(1);
  1653.        }
  1654.    } # if ($? == 0)
  1655.    else
  1656.    {
  1657.        # $? != 0; rsh failed.
  1658.        &lan_error_msg_print;
  1659.        if ($Verbose)
  1660.        {
  1661.        &Error(0,"Rsh failed with output:\n$chk_out\nQuitting ...\n");
  1662.        }
  1663.        &Error(1,"Couldn't Run '$chk_cmd'\n");
  1664.    }
  1665.  
  1666.    return $remote_automounter;
  1667. } # end of "sub chkcfg_check"
  1668.  
  1669. #####################################################################
  1670. #                  SUBROUTINE AUTOMOUNTER_CHECK                     #
  1671. # Check to see if automount running on remote host.                 #
  1672. #####################################################################
  1673. sub automounter_check {
  1674.    local ($remote_host, $automounter, $timeout) = @_;
  1675.    local ($ps_cmd, $ps_out, @ps_lines);
  1676.  
  1677.    &Notice("Ensuring '$automounter' Operational On '$remote_host'\n");
  1678.    $ps_cmd = "/usr/bsd/rsh $remote_host -n /sbin/ps -ef";
  1679.    $ps_out = &do_cmd_with_timeout ($ps_cmd, $timeout);
  1680.  
  1681.    if ($? == 0) {
  1682.       # Grep for automount.
  1683.       @ps_lines = grep ((/$remote_automounter/ && !/grep\s*$remote_automounter/),
  1684.             split(/\n/, $ps_out));
  1685.       if (@ps_lines) {
  1686.       &Notice("Automounter Running On '$remote_host'\n");
  1687.       }
  1688.       else {
  1689.          &lan_error_msg_print;
  1690.      &Error(1,"Automounter Not Running On '$remote_host'\n");
  1691.       }
  1692.    }
  1693.    else {
  1694.       # $? != 0; rsh failed.
  1695.       &lan_error_msg_print;
  1696.       &Error(1,"Remote Command '$ps_cmd' Failed With Output:\n$ps_out");
  1697.    }
  1698. } # end of "sub automounter_check"
  1699.  
  1700. #####################################################################
  1701. #                  SUBROUTINE EXPORTS_CHECK                         #
  1702. # Test cd'ing to /hosts/$remote_host and examining <etc/exports>.   #
  1703. #####################################################################
  1704. sub exports_check {
  1705.    local ($remote_host, $automounter, $timeout) = @_;
  1706.    local ($cat_cmd, $cat_out, @cat_lines, $nxt_line, $dir_name);
  1707.    local ($all_lines_good, $found_line, $exp_dir, $this_dir);
  1708.  
  1709.    # First, get the contents of the /etc/exports file from remote host.
  1710.  
  1711.    $cat_cmd = "/usr/bsd/rsh $remote_host -n /sbin/cat -u /etc/exports";
  1712.    $cat_out = &do_cmd_with_timeout ($cat_cmd, $timeout);
  1713.  
  1714.    if ($? == 0) {
  1715.       ###############################################################
  1716.       # Rsh successful, check to see if cat was successful by       #
  1717.       # examining the first line from cat_out for an ERROR line.    #
  1718.       # If ERROR appears, then error in reading /etc/exports.       #
  1719.       # (If error, the output looks like one of                     #
  1720.       # UX:cat: ERROR: Cannot open mine: No such file or directory  #
  1721.       # UX:cat: ERROR: Cannot open /mine: Permission denied ...     #
  1722.       # So look for /^\s*UX:cat:\s*ERROR:/ in the first line.)      #
  1723.       ###############################################################
  1724.       @cat_lines = split (/\n/, $cat_out);
  1725.       if ($cat_lines[0] =~ /^\s*UX:cat:\s*ERROR:/) {
  1726.           &lan_warning_msg_print;
  1727.       &Warning("Command 'cat /etc/exports' Failed On '$remote_host'\n");
  1728.           if ($cat_out =~ /No such file/) {
  1729.          &Warning("File '/etc/exports' Does Not Exist On '$remote_host'\n");
  1730.           }
  1731.           elsif ($cat_out =~ /Permission denied/) {
  1732.          &Warning("File '/etc/exports' On '$remote_host' Is Not Readable By You\n");
  1733.           }
  1734.       }
  1735.       else {
  1736.          ###########################################################
  1737.          # Cat was successful.                                     #
  1738.          # Look for atleast one uncommented line, and then try to  #
  1739.          # cd to it. (Ex. if line is '/', then the corresponding   #
  1740.          # dir is /hosts/$remote_host/). If unable to, then warn.  #
  1741.          ###########################################################
  1742.          $found_line = 0;
  1743.          $all_lines_good = 1;
  1744.          $this_dir = `pwd`;   # So I can come back to it.
  1745.          chop($this_dir);
  1746.          foreach $nxt_line (@cat_lines) {
  1747.             if ($nxt_line !~ /^\s*#/) {
  1748.                if ($found_line == 0) {
  1749.                   $found_line = 1;
  1750.                }
  1751.                # The first field is the exported directory.
  1752.                $exp_dir = (split(' ', $nxt_line))[0];
  1753.                #####################################################
  1754.                # If automount/fs being used,check /hosts/<host>/...#
  1755.                # If amd being used, check /r/<host>/...            #
  1756.                #####################################################
  1757.                if (($automounter eq "automount") ||
  1758.                    ($automounter eq "autofs")) {
  1759.                   $dir_name = "/hosts/$remote_host$exp_dir";
  1760.                }
  1761.                else {
  1762.                   $dir_name = "/r/$remote_host$exp_dir";
  1763.                }
  1764.                if (!(-e $dir_name)) {
  1765.                   &lan_warning_msg_print;
  1766.                   $all_lines_good = 0;
  1767.                   &Error(0,"NFS Directory '%s' in '%s:%s' Doesn't Exist\n",
  1768.                $dir_name,$remote_host,"/etc/exports");
  1769.                }
  1770.                elsif (chdir "$dir_name") {
  1771.                   # Now, chdir back to original place.
  1772.                   chdir "$this_dir" ||
  1773.               &InternalError(__LINE__,__FILE__,
  1774.                      "Unable to cd to '$this_dir': $!\n");
  1775.                }
  1776.                else {
  1777.                   &lan_warning_msg_print;
  1778.                   $all_lines_good = 0;
  1779.                   &Error(0,"Can't 'cd' To NFS Directory '%s' in '%s:%s'\n",
  1780.                $dir_name,$remote_host,"/etc/exports");
  1781.                }
  1782.             }
  1783.          }
  1784.          if ($found_line) {
  1785.             if ($all_lines_good) {
  1786.         &Notice("Entries In '%s:%s' Pass Verification\n",
  1787.             $remote_host,"/etc/exports");
  1788.             }
  1789.             else {
  1790.         &Error(0,"Some Nodes Export Unreachable NFS Directories\n");
  1791. #FIX: put suggestions here
  1792.         &ExitGracefully(1);
  1793.             }
  1794.          }
  1795.          else {
  1796.             &lan_warning_msg_print;
  1797.         &Notice("Node '$remote_host' NFS Exports No Directories\n");
  1798.          }
  1799.       } # else (cat succeeded)
  1800.    } # if ($? = 0)
  1801.  
  1802.    else { #$? != 0
  1803.       &lan_error_msg_print;
  1804.       &Error(1,"Remote Command '$cat_cmd' Failed With Output:\n$cat_out");
  1805.    }
  1806. } # end of "sub exports_check"
  1807.  
  1808. ####################################################################
  1809. #                 SUBROUTINE LAN_ERROR_MSG_PRINT                   #
  1810. ####################################################################
  1811. sub lan_error_msg_print {
  1812.  
  1813. if ($Verbose)
  1814. {
  1815.     print STDERR <<'LAN_ERRMSG';
  1816.  
  1817. ERROR ERROR ERROR ERROR ERROR ERROR ERROR ERROR ERROR ERROR ERROR ERROR
  1818. ERROR                                                             ERROR
  1819. ERROR             *** LAN  NODE DIAGNOSTICS FAILED ***            ERROR
  1820. ERROR                                                             ERROR
  1821. ERROR ERROR ERROR ERROR ERROR ERROR ERROR ERROR ERROR ERROR ERROR ERROR
  1822.  
  1823. LAN_ERRMSG
  1824.  
  1825. }
  1826.  
  1827. } # end of "lan_error_msg_print"
  1828.  
  1829. ####################################################################
  1830. #                SUBROUTINE LAN_WARNING_MSG_PRINT                  #
  1831. ####################################################################
  1832. sub lan_warning_msg_print {
  1833.  
  1834.     local($warning_msg) = @_;
  1835.     local ($ans);
  1836.  
  1837.     print <<"LAN_WARNMSG";
  1838.        *** WARNING FROM CONNECTIVITY TESTS ***\n
  1839.        $warning_msg;
  1840.  
  1841. LAN_WARNMSG
  1842.  
  1843.     print "Continue Y/N ";
  1844.     chop ($ans = <STDIN>);
  1845.     if ($ans eq Y) {
  1846.     return (1);
  1847.     }
  1848.     else {
  1849.     return (0);
  1850.     }
  1851.  
  1852. }
  1853.  
  1854. # end of "lan_warning_msg_print"
  1855.  
  1856. #=============================================================================
  1857. #
  1858. #    RunCommandsWithTimeout(timeout,commands...)
  1859. #
  1860. #    This routine simultaneously spawns a bunch of commands, and sets
  1861. #    a timeout for all of them.  The program returns the count of
  1862. #    commands which did not return before the timeout expired, and a list
  1863. #    of filenames:return-status, one corresponding to each command in the
  1864. #    list, which contains the output for each command.  If the command
  1865. #    timed out, the filename is the empty string.  The program return
  1866. #    status follows the filename, and is separated by a colon.  The caller
  1867. #    is responsible for deleting the temporary file.
  1868. #
  1869. #    Subroutines:        SpawnCommand, TimeoutHandler
  1870. #    Global variables:    %DONE, $SIG{'ALRM'}
  1871. #
  1872. #=============================================================================
  1873.  
  1874. #sub RunCommandsWithTimeout
  1875. #{
  1876. #        local($timeout,@commands) = @_;
  1877.  
  1878. #        local($command,$timed_out,$num_spawned,$num_done,$index,$old_sig);
  1879. #    local($child_pid,$out_file,$num_spawned,$dead_pid,$dead_status);
  1880. #    local($i,$done,$num_drowzy,$str);
  1881. #        local(@output_files);
  1882. #    local(%PIDS,%MACHINES,%COMMANDS,%OUTFILES,%STATUS);
  1883.  
  1884. #        $timed_out = 0;
  1885.  
  1886. ##
  1887. ##       Spawn Commands
  1888. ##
  1889. #        $num_spawned = 0;
  1890. #        $num_done = 0;
  1891. #        $index = 0;
  1892.  
  1893. #        foreach $command (@commands)
  1894. #        {
  1895. #                ($child_pid,$out_file) = &SpawnCommand($command);
  1896. #                if ($child_pid > 0)
  1897. #                {
  1898. #                        $PIDS{$index++} = $child_pid;
  1899. #                        $COMMANDS{$child_pid} = $command;
  1900. #                        $OUTFILES{$child_pid} = $out_file;
  1901. #            $STATUS{$child_pid} = -1;
  1902. #                        $DONE{$child_pid} = 0;
  1903. #                        ++ $num_spawned;
  1904. #                }
  1905. #        }
  1906.  
  1907. ##
  1908. ##       Set Up Timeout
  1909. ##
  1910. #    $old_sig = $SIG{'ALRM'};
  1911. #        $SIG{'ALRM'} = 'TimeoutHandler';
  1912. #        alarm($timeout);
  1913.  
  1914. ##
  1915. ##       Wait For Jobs To Finish or Timeout
  1916. ##
  1917.  
  1918. #        while (1)
  1919. #        {
  1920. #                $dead_pid = wait;
  1921. #        $dead_status = ($? >> 8);
  1922.  
  1923. #                if ($dead_pid != -1)
  1924. #                {
  1925. #                        if ($DONE{$dead_pid} == 0)
  1926. #                        {
  1927. #                                $DONE{$dead_pid} = 1;
  1928. #                $STATUS{$dead_pid} = $dead_status;
  1929. #                                ++ $num_done;
  1930. #                        }
  1931. #                }
  1932.  
  1933. #                if ($num_done == $num_spawned)
  1934. #                {
  1935. #                        last;
  1936. #                }
  1937. #                if ($timed_out)
  1938. #                {
  1939. #                        last;
  1940. #                }
  1941. #        }
  1942.  
  1943. ##
  1944. ##       Disable Timeout
  1945. ##
  1946.  
  1947. #        alarm(0);
  1948. #        $SIG{'ALRM'} = $old_sig;
  1949.  
  1950. ##
  1951. ##       Collect Results
  1952. ##
  1953.  
  1954. #        @output_files = ();
  1955.  
  1956. #        for ($i = 0; $i < $index; $i++)
  1957. #        {
  1958. #                $child_pid = $PIDS{$i};
  1959. #                $done = $DONE{$child_pid};
  1960.  
  1961. #                if ($done == 1)
  1962. #                {
  1963. #            $str = sprintf("%s:%d",$OUTFILES{$child_pid},
  1964. #                       $STATUS{$child_pid});
  1965. #                }
  1966. #                    else
  1967. #                {
  1968. #            $str = sprintf("%s:%d","",$STATUS{$child_pid});
  1969. #                        unlink($OUTFILES{$child_pid});
  1970. #                }
  1971. #        push(@output_files,$str);
  1972. #        }
  1973.  
  1974. #        $num_drowzy = ($num_spawned - $num_done);
  1975. #        return($num_drowzy,@output_files);
  1976. #}
  1977.  
  1978. ##=============================================================================
  1979. ##
  1980. ##    OSVersion()
  1981. ##
  1982. ##    This routine returns the IRIX version number as a numeric value,
  1983. ##    or "0" if it cannot be determined. "Sub-minor" numbers (e.g. the
  1984. ##    ".1" in "6.4.1") are ignored.
  1985. ##
  1986. ##=============================================================================
  1987.  
  1988. #sub OSVersion
  1989. #{
  1990. #    local ($uname_out, $OSVer);
  1991.  
  1992. #    $uname_out = `/sbin/uname -r`;
  1993. #    chop($uname_out);
  1994.  
  1995. #    if ($uname_out =~ /^(\d+\.\d+)/) {
  1996. #        $OSVer = $1;
  1997. #    }
  1998. #    else {
  1999. #        &Warning("Unable to determine OS version\n");
  2000. #        $OSVer = 0;
  2001. #    }
  2002.  
  2003. #    return($OSVer);
  2004. #}
  2005.  
  2006. ##=============================================================================
  2007. ##
  2008. ##    GetIPByDeviceName(device_name,[remote_host])
  2009. ##
  2010. ##    This routine returns a hostname and a dotted string representation of
  2011. ##    associated IP address for a device named <device_name> on the local
  2012. ##    host, or if <remote_host> is set, on that host.
  2013. ##
  2014. ##    The routine returns a triple (<hostname>,<hostaddr>,<upness>) that
  2015. ##    indicates the hostname of the interface, the IP address of the interface
  2016. ##    in "dotted string" notation, and a boolean indicating whether the
  2017. ##    interface is currently up.
  2018. ##
  2019. ##=============================================================================
  2020.  
  2021. #sub GetIPByDeviceName
  2022. #{
  2023. #    local($device_name,$remote_host) = @_;
  2024. #    local($log,@result);
  2025.  
  2026. #    $log = &DoNetstat($remote_host);
  2027. #    @result = &GetIPByDeviceNameAndNetstatFile($device_name,$log);
  2028. #    unlink($log);
  2029.  
  2030. #    return(@result);
  2031. #}
  2032.  
  2033. ##=============================================================================
  2034. ##
  2035. ##    DoNetstat([remote_host])
  2036. ##
  2037. ##    This routine returns the filename of a local file that contains the
  2038. ##    netstat lines from netstat run on the local host, or on <remote_host>
  2039. ##    if defined.
  2040. ##
  2041. ##=============================================================================
  2042.  
  2043. #sub DoNetstat
  2044. #{
  2045. #    local($remote_host) = @_;
  2046. #    local($log,@result);
  2047.  
  2048. #    if ($remote_host eq "")
  2049. #    {
  2050. #        @result = &RunCommandsWithTimeout(10,"/usr/etc/netstat -in");
  2051. #    }
  2052. #        else
  2053. #    {
  2054. #        @result = &RunCommandsWithTimeout(10,
  2055. #            "/usr/bsd/rsh $remote_host -n /usr/etc/netstat -in");
  2056. #    }
  2057.  
  2058. #    if ($result[0] != 0)
  2059. #    {
  2060. #        &Error(1,"Timeout Of '/usr/etc/netstat -in'\n");
  2061. #    }
  2062. #    $log = (split(':',$result[1]))[0];
  2063. #    return($log);
  2064. #}
  2065.  
  2066. #=============================================================================
  2067. #
  2068. #    GetNetworkInterfaces([remote_host])
  2069. #
  2070. #    This function gets the network interfaces on the local host,
  2071. #    or on the host <remote_host> if defined, and returns a list of
  2072. #    strings, one string per interface.
  2073. #
  2074. #    Each string is composed of "<ifname>:<hostname>:<ipaddr>:<up>"
  2075. #
  2076. #=============================================================================
  2077.  
  2078. #sub GetNetworkInterfaces
  2079. #{
  2080. #    local($remote_host) = @_;
  2081. #    local($file,$pattern,$line,@result,$if,$hn,$ip,$up,@interfaces);
  2082.  
  2083. #    $file = &DoNetstat($remote_host);
  2084. #    open(INGNI,$file) || &Error(1,"Can't Open '$file'\n");
  2085.  
  2086. #    $pattern = "^([^ \\*]+)([ \\*])\\s*\\S+\\s+(\\S+)\\s+(\\S+)\\s+";
  2087. #    while ($line = <INGNI>)
  2088. #    {
  2089. #        chop($line);
  2090. #        @result = ($line =~ $pattern);
  2091. #        if (@result != 4) { next; }
  2092. #        if ($result[0] eq "Name") { next; }
  2093.  
  2094. #        $if = $result[0];
  2095. #        $ip = $result[3];
  2096. #        $up = ($result[1] ne "*");
  2097. #        $hn = &IPAddressToHostname($ip);
  2098.  
  2099. #        push(@interfaces,"$if:$hn:$ip:$up");
  2100. #    }
  2101. #    close(INGNI);
  2102. #    return(@interfaces);
  2103. #}
  2104.  
  2105. ##=============================================================================
  2106. ##
  2107. ##    GetIPByDeviceNameAndNetstatFile(device_name,file)
  2108. ##
  2109. ##    This is a low-level helper routine for GetIPByDeviceName.  It takes
  2110. ##    a file name <file>, produced by 'netstat -in', and searches it for
  2111. ##    the device <device_name>.
  2112. ##
  2113. ##    The routine returns a hostname and a dotted string representation of
  2114. ##    the associated IP address for a device named <device_name>.  The
  2115. ##    routine returns a triple (<hostname>,<hostaddr>,<upness>) that
  2116. ##    indicates the hostname of the interface, the IP address of the
  2117. ##    interface in "dotted string" notation, and a boolean indicating
  2118. ##    whether the interface is currently up.
  2119. ##
  2120. ##=============================================================================
  2121.  
  2122. #sub GetIPByDeviceNameAndNetstatFile
  2123. #{
  2124. #    local($device_name,$file) = @_;
  2125. #    local($line,$ip,$hostname,$up);
  2126. #    local(@result);
  2127.  
  2128. #    open(INGIBD,$file) || &Error(1,"Can't Open '$file'\n");
  2129.  
  2130. #    $pattern = "^([^ \\*]+)([ \\*])\\s*\\S+\\s+(\\S+)\\s+(\\S+)\\s+";
  2131. #    while ($line = <INGIBD>)
  2132. #    {
  2133. #        @result = ($line =~ $pattern);
  2134. #        if (@result != 4) { next; }
  2135. #        if ($result[0] ne $device_name) { next; }
  2136.  
  2137. #        $up = ($result[1] ne "*");
  2138. #        $ip = $result[3];
  2139. #        $hostname = &IPAddressToHostname($ip);
  2140.  
  2141. #        close(GIBD);
  2142. #        return($hostname,$ip,$up);
  2143. #    }
  2144.  
  2145. #    close(GIBD);
  2146. #    return();
  2147. #}
  2148.  
  2149. ##=============================================================================
  2150. ##
  2151. ##    SelectBestInterface([remote_host])
  2152. ##
  2153. ##    This routine returns the interface name of the "best" network
  2154. ##    interface on the local machine, or on the host <remote_host>
  2155. ##    if defined. The definition of "best" is a judgement call based
  2156. ##    on factors like throughput and latency, and is encapsulated in
  2157. ##    the array "InterfacesByQuality".
  2158. ##
  2159. ##    If the global variable "FastIF" has a value, it is always
  2160. ##    returned as the "best" interface if it exists.
  2161. ##
  2162. ##    The result is returned in the form "<ifname>:<hostname>:<ipaddr>",
  2163. ##    or an empty string if no interfaces are recognized.
  2164. ##
  2165. ##=============================================================================
  2166.  
  2167. #sub SelectBestInterface
  2168. #{
  2169. #    local($remote_host) = @_;
  2170. #    local(@InterfacesByQuality,@interfaces,@result);
  2171. #    local($best,$bestquality,$currpatt);
  2172. #    local($entry,$if,$hn,$ip,$up,$curr,$currquality);
  2173.  
  2174. #    @InterfacesByQuality = ("hip[0-9]+",
  2175. #                "xpi[0-9]+",
  2176. #                "ipg[0-9]+",
  2177. #                "ef[0-9]+",
  2178. #                "fxp[0-9]+",
  2179. #                "et[0-9]+",
  2180. #                "ec[0-9]+",
  2181. #                "lo0");
  2182. #    @interfaces = &GetNetworkInterfaces($remote_host);
  2183.  
  2184. #    $best = "";
  2185. #    $bestquality = 999;
  2186. #    foreach $entry (@interfaces)
  2187. #    {
  2188. #        @result = split(":",$entry);
  2189. #        if (@result != 4)
  2190. #        {
  2191. #            next;
  2192. #        }
  2193.  
  2194. #        ($if,$hn,$ip,$up) = @result;
  2195. #        if (! $up) {
  2196. #            next;
  2197. #        }
  2198. #        $curr = "$if:$hn:$ip";
  2199.  
  2200. #        if ($if eq $FastIF) {
  2201. #            return($curr);
  2202. #        }
  2203.  
  2204. #        $currquality = 0;
  2205. #        foreach $currpatt (@InterfacesByQuality)
  2206. #        {
  2207. #            last if $if =~ /$currpatt/;
  2208. #            ++$currquality;
  2209. #        }
  2210.  
  2211. #        if ($currquality >= @InterfacesByQuality) {
  2212. #            &Warning("Don't know about interface type '$if'\n");
  2213. #        }
  2214.  
  2215. #        if ($currquality < $bestquality) {
  2216. #            $best = $curr;
  2217. #            $bestquality = $currquality;
  2218. #        }
  2219. #    }
  2220.  
  2221. #    return($best);
  2222. #}
  2223.  
  2224. ##=============================================================================
  2225. ##
  2226. ##    GetArrayMachines([array])
  2227. ##
  2228. ##    This routine returns the list of machines comprising the array
  2229. ##    named <array>, or the default array if unspecified.
  2230. ##
  2231. ##=============================================================================
  2232.  
  2233. #sub GetArrayMachines
  2234. #{
  2235. #    local($array) = @_;
  2236. #    local($log,$options,$cmd,$line,$host,@result,@machines);
  2237.  
  2238. #    if ($array ne "") { $options = "-a $array"; }
  2239.  
  2240. #    $cmd = "ainfo -f 3 $options machines";
  2241. #    @result = &RunCommandsWithTimeout(10,$cmd);
  2242.  
  2243. #    if ($result[0] != 0) { &Error(1,"Timeout Of '$cmd'\n"); }
  2244.  
  2245. #    $log = (split(':',$result[1]))[0];
  2246.  
  2247. #    open(INGAM,$log) || &Error(1,"Can't Open File '$log'\n");
  2248. #    while ($line = <INGAM>)
  2249. #    {
  2250. #        @result = ($line =~ "^(\\S+)\$");
  2251. #        if (@result != 1)
  2252. #        {
  2253. #            chop($line);
  2254. #            &Error(0,"Unexpected Line '$line' From '$cmd'\n");
  2255. #            &Suggest("Verify '$cmd' Is Working Properly\n");
  2256. #            &ExitGracefully(1);
  2257. #        }
  2258. #        push(@machines,$result[0]);
  2259. #    }
  2260. #    close(INGAM);
  2261.  
  2262. #    unlink($log);
  2263.  
  2264. #    return(@machines);
  2265. #}
  2266.  
  2267. ##=============================================================================
  2268. ##
  2269. ##    DoesHostnameExist(hostname)
  2270. ##
  2271. ##    This routine takes a hostname <hostname>, and returns 1 if the
  2272. ##    hostname is valid, 0 if the hostname is unknown.
  2273. ##
  2274. ##=============================================================================
  2275.  
  2276. #sub DoesHostnameExist
  2277. #{
  2278. #    local($hostname) = @_;
  2279. #    local(@result);
  2280.  
  2281. #    @result = &GetHost($hostname,"name",10);
  2282. #    return($result[0] ne "");
  2283. #}
  2284.  
  2285. ##=============================================================================
  2286. ##
  2287. ##    GetHost(key,keytype,timeout)
  2288. ##
  2289. ##    This routine returns host entry info for the host specified by <key>.
  2290. ##    The <key> value is a string containing either a hostname, or an IP
  2291. ##    address in "dotted string" notation.  The <keytype> field indicates
  2292. ##    if the key is a "name" or an "addr".
  2293. ##
  2294. ##    This routine calls the perl gethostbyname() or gethostbyaddr()
  2295. ##    services respectively, within <timeout> seconds.
  2296. ##
  2297. ##    On exit, GetHost() returns the host entry array as returned by
  2298. ##    gethostbyaddr() and gethostbyname().  The empty list is returned
  2299. ##    if no match is found.
  2300. ##
  2301. ##=============================================================================
  2302.  
  2303. sub GetHostTimeoutHandler
  2304. {
  2305.   $GetHostTimeoutHandler_timed_out = 1;
  2306. }
  2307.  
  2308. sub GetHost
  2309. {
  2310.   local($key,$keytype,$timeout) = @_;
  2311.  
  2312.   local($old_sig,@host_entry,$packed_addr);
  2313.  
  2314.   if (($keytype ne "name") && ($keytype ne "addr")){
  2315.     &InternalError(__LINE__,__FILE__,
  2316.            "GetHost passed keytype '$keytype'");
  2317.   }
  2318.  
  2319.   $GetHostTimeoutHandler_timed_out = 0;
  2320.  
  2321.   $old_sig = $SIG{'ALRM'};
  2322.   $SIG{'ALRM'} = 'GetHostTimeoutHandler';
  2323.   alarm($timeout);
  2324.  
  2325.   if ($keytype eq "name") {
  2326.     @host_entry = gethostbyname($key);
  2327.   } else {
  2328.     $packed_addr = &DottedAddrToAddr($key);
  2329.     @host_entry = gethostbyaddr($packed_addr,2);
  2330.   }
  2331.  
  2332.   alarm(0);
  2333.   $SIG{'ALRM'} = $old_sig;
  2334.  
  2335.   if ($GetHostTimeoutHandler_timed_out) {
  2336.     &Error(1,"Timeout Looking Up Host Entry For '$key'");
  2337.   }
  2338.  
  2339.   #print STDERR "GetHost($key,$keytype,$timeout) -> (" . join(",",@host_entry[0..3]) . ")\n";
  2340.   return(@host_entry);
  2341. }
  2342.  
  2343. ##=============================================================================
  2344. ##
  2345. ##    IPAddressToHostname(ip)
  2346. ##
  2347. ##    This routine takes an IP address <ip>, in "dotted string" notation,
  2348. ##    and looks up the host name for the IP address with a timeout.
  2349. ##
  2350. ##=============================================================================
  2351.  
  2352. #sub IPAddressToHostname
  2353. #{
  2354. #    local($addr) = @_;
  2355. #    local(@host_entry,$name);
  2356.  
  2357. #    if ($addr eq "none") {
  2358. #        return("");
  2359. #    }
  2360.  
  2361. #    @host_entry = &GetHost($addr,"addr",10);
  2362.  
  2363. #    $name = $host_entry[0];
  2364. #    if ($name eq "") { $name = $addr; }
  2365.  
  2366. ##print STDERR "IPAddressToHostname($addr) --> '$name'\n";
  2367. #    return($name);
  2368. #}
  2369.  
  2370. ##=============================================================================
  2371. ##
  2372. ##    HostnameToIPAddress(hostname)
  2373. ##
  2374. ##    This routine takes a host name <hostname> and looks up the IP
  2375. ##    address for the host with a timeout.
  2376. ##
  2377. ##=============================================================================
  2378.  
  2379. sub HostnameToIPAddress
  2380. {
  2381.   local($name) = @_;
  2382.   local(@host_entry,$addr);
  2383.  
  2384.   @host_entry = &GetHost($name,"name",10);
  2385.  
  2386.   $addr = join(".",unpack("C4",$host_entry[4]));
  2387.   if ($addr eq ""){
  2388.     &Error(1,"Couldn't Find IP Address For Host '%s'",$name);
  2389.   }
  2390.  
  2391.   return($addr);
  2392. }
  2393.  
  2394. ##=============================================================================
  2395. ##
  2396. ##    IPAddressToUnambiguousHostname(ip)
  2397. ##
  2398. ##    This routine takes an IP address <ip>, in "dotted string" notation,
  2399. ##    and converts it to a hostname which, if converted back to an IP
  2400. ##    address, will result in the original IP address.
  2401. ##
  2402. ##=============================================================================
  2403.  
  2404. sub IPAddressToUnambiguousHostname
  2405. {
  2406.   local($addr) = @_;
  2407.   local(@host_entry,$name,$newaddr);
  2408.  
  2409.   # convert address to hostname
  2410.  
  2411.   @host_entry = &GetHost($addr,"addr",10);
  2412.   $name = $host_entry[0];
  2413.   if ($name eq "") { $name = $addr; }
  2414.  
  2415.   # convert hostname back to address
  2416.  
  2417.   @host_entry = &GetHost($name,"name",10);
  2418.   $newaddr = join(".",unpack("C4",$host_entry[4]));
  2419.   if ($newaddr eq ""){
  2420.     &Error(1,"IP '$addr' Converts To '$name' Which Is Unbound");
  2421.   }
  2422.  
  2423.   # if the addresses are the same, using the name as the
  2424.   # canonical hostname, otherwise use the dotted string form
  2425.   # of the address as the canonical hostname
  2426.  
  2427.   if ($newaddr eq $addr) {
  2428.     return($name);
  2429.   }
  2430.   return($addr);
  2431. }
  2432.  
  2433. ##=============================================================================
  2434. ##
  2435. ##    CanonicalizeHostname(hostname)
  2436. ##
  2437. ##    This routine takes a hostname <hostname>, and returns a canonical
  2438. ##    hostname for this interface.
  2439. ##
  2440. ##=============================================================================
  2441.  
  2442. sub CanonicalizeHostname
  2443. {
  2444.   local($hostname) = @_;
  2445.   local($addr,$canon);
  2446.  
  2447.   $addr = &HostnameToIPAddress($hostname);
  2448.   $canon = &IPAddressToUnambiguousHostname($addr);
  2449.   &Debug("CanonicalizeHostname(%s) addr: %s canon: %s",
  2450.      $hostname, $addr, $canon);
  2451.  
  2452.   return($canon);
  2453. }
  2454.  
  2455. ##=============================================================================
  2456. ##
  2457. ##    GetHippiInventory()
  2458. ##
  2459. ##    Parses the output from hinv to determine how many hippi adapters
  2460. ##    (if any) are installed. The device names of each adapter are
  2461. ##    stored in the global variable "@HippiAdapters" and the number of
  2462. ##    adapters is returned.
  2463. ##
  2464. ##=============================================================================
  2465. #sub GetHippiInventory
  2466. #{
  2467. #    local ($hinv_out, $num_hippi, $hl, $hipsname);
  2468. #    local (@hinv_list, @hippi_list, @result);
  2469.  
  2470. #    $hinv_out = `/sbin/hinv 2>&1`;
  2471.  
  2472. #    if ($? == 0) {
  2473. #        # hinv successful.
  2474. #        chop ($hinv_out);
  2475. #        @hinv_list = split (/\n/, $hinv_out);
  2476. #        @hippi_list = grep (/HIPPI adapter|HIPPI-Serial adapter/,
  2477. #                    @hinv_list);
  2478.  
  2479. #        $num_hippi = @hippi_list;
  2480. #        if ($num_hippi == 0) {
  2481. #            return (0);
  2482. #        }
  2483.  
  2484. #        &Notice("%d HiPPI Interfaces Show Up In Inventory\n",
  2485. #            $num_hippi);
  2486. #        if ($Verbose)
  2487. #        {
  2488. #            &Notice("@hippi_list\n");
  2489. #        }
  2490.  
  2491. #        foreach $hl (@hippi_list)
  2492. #        {
  2493. #            if ($hl =~ /HIPPI adapter/) {
  2494. #                @result = ($hl =~ "^HIPPI adapter: ([^,]+), slot (\\S+) adap (\\S+)");
  2495. #                if (@result != 3) {
  2496. #                    &Warning("Bad hinv Line (%d) $hl",
  2497. #                         @result);
  2498. #                    return (-1);
  2499. #                }
  2500. #                &Notice("HiPPI Interface '%s' Is In Slot %d, Adapt %d\n",
  2501. #                    $result[0],$result[1],$result[2]);
  2502. #                push(@HippiAdapters,$result[0]);
  2503. #            }
  2504. #            else {
  2505. #                @result = ($hl =~ "^HIPPI-Serial adapter: unit (\\d+), in module (\\d+) I/O slot (\\d+)");
  2506. #                if (@result != 3) {
  2507. #                    &Warning("Bad hinv Line (%d) $hl",
  2508. #                         @result);
  2509. #                    return (-1);
  2510. #                }
  2511. #                $hipsname = "hippi$result[0]";
  2512. #                &Notice("HiPPI-Serial Interface '%s' Is In Module %d, Slot %d\n",
  2513. #                    $hipsname,$result[1],$result[2]);
  2514. #                push(@HippiAdapters,$hipsname);
  2515. #            }
  2516. #        }
  2517. #    }
  2518. #    else {
  2519. #        # $? != 0; i.e., hinv failed.
  2520. #        &Warning("Couldn't Run 'hinv' to determine presence of HiPPI devices\n");
  2521. #        return (-1);
  2522. #    }
  2523.  
  2524. #    return ($num_hippi);
  2525. #}
  2526.  
  2527. ##=============================================================================
  2528. ##
  2529. ##    ParseImapFile(filename)
  2530. ##
  2531. ##    This routine parses the imap file <filename>, usually
  2532. ##    /usr/etc/hippi.imap, and extracts the hostname to I-Field mappings.
  2533. ##    The mappings are returned as a list of strings.  Each string is a
  2534. ##    space-separated value consisting of <interfacename>, <ifield>, and
  2535. ##    optional <ula>.
  2536. ##
  2537. ##=============================================================================
  2538.  
  2539. #sub ParseImapFile
  2540. #{
  2541. #    local($file) = @_;
  2542. #    local($line,$lineno,$entry,$warnings,@r3,@r2,@r1,@r,@entries);
  2543.  
  2544. #    open(IN,"$file") || &Error(1,"Can't Open '$file'\n");
  2545.  
  2546. #    $lineno = 0;
  2547. #    $warnings = 0;
  2548. #    while ($line = <IN>)
  2549. #    {
  2550. #        ++ $lineno;
  2551. #        chop($line);
  2552.  
  2553. #        @r = ();
  2554.  
  2555. #        ($line) = ($line =~ "^([^#]*)");
  2556. #        @r3 = ($line =~ "^\\s*(\\S+)\\s+(\\S+)\\s+(\\S+)");
  2557. #        @r2 = ($line =~ "^\\s*(\\S+)\\s+(\\S+)");
  2558. #        if (@r3 == 3)        { @r = @r3; }
  2559. #          elsif (@r2 == 2)    { @r = (@r2,""); }
  2560. #          elsif (@r1 == 1)
  2561. #        {
  2562. #            &Warning("Line %d Of '%s' Has Single Field Entry\n",
  2563. #                $lineno,$file);
  2564. #            ++ $warnings;
  2565. #        }
  2566.  
  2567. #        if (@r == 3)
  2568. #        {
  2569. #            push(@entries,join(" ",@r));
  2570. #            if (! ($r[1] =~ /^0x/))
  2571. #            {
  2572. #                &Warning("Line %d Of '%s' Has Ifield Without '0x' Prefix\n",
  2573. #                    $lineno,$file);
  2574. #                ++ $warnings;
  2575. #            }
  2576. #        }
  2577. #    }
  2578.  
  2579. #    close(IN);
  2580.  
  2581. #    if ($warnings) { &Suggest("$warnings Warnings, Ensure '$file' Is Correct\n"); }
  2582.  
  2583. #    return(@entries);
  2584. #}
  2585.  
  2586. ##=============================================================================
  2587. ##
  2588. ##    ParseIfield(ifield)
  2589. ##
  2590. ##    This routine takes an Ifield in hexadecimal if begins with 0x, or
  2591. ##    decimal otherwise, an returns a decoded list, consisting of:
  2592. ##
  2593. ##        ($L,$VU,$W,$D,$PS,$C,$RC)
  2594. ##
  2595. ##    Where:    $L is 0 or 1, 1 meaning locally-defined protocol
  2596. ##        $VU is 0 to 3, for vendor use
  2597. ##        $W is 32 or 64, for bus size
  2598. ##        $D is "LSB" or "MSB", the direction of address consumption
  2599. ##        $PS is "Source", "Logical", "RSVD", and "Logical (Best)"
  2600. ##        $C is "Camp" or "NoCamp"
  2601. ##        $RC is the routing path, a 24 bit hexadecimal number string
  2602. ##
  2603. ##=============================================================================
  2604.  
  2605. #sub ParseIfield
  2606. #{
  2607. #    local($ifield) = @_;
  2608. #    local($t,$L,$VU,$W,$D,$PS,$C,$RC);
  2609.  
  2610. #    if ($ifield =~ /^0x/) { $ifield = oct($ifield); }
  2611.  
  2612. #    $L = ($ifield >> 31) & 1;
  2613. #    $VU = ($ifield >> 29) & 3;
  2614. #    $W = (($ifield >> 28) & 1 ? 64 : 32);
  2615. #    $D = (($ifield >> 27) & 1 ? "MSB" : "LSB");
  2616.  
  2617. #    $t = ($ifield >> 25) & 3;
  2618. #    if ($t == 0)        { $PS = "Source"; }
  2619. #      elsif ($t == 1)    { $PS = "Logical"; }
  2620. #      elsif ($t == 2)    { $PS = "RSVD"; }
  2621. #      elsif ($t == 3)    { $PS = "Logical (Best)"; }
  2622.  
  2623. #    $C = (($ifield >> 24) & 1 ? "Camp" : "NoCamp");
  2624. #    $RC = sprintf("0x%06X",($ifield & 0xFFFFFF));
  2625.  
  2626. #    return($L,$VU,$W,$D,$PS,$C,$RC);
  2627. #}
  2628.  
  2629. ##=============================================================================
  2630. ##
  2631. ##    HostnameToIfield(hostname)
  2632. ##
  2633. ##    This routine takes a hostname of a HIPPI device, reads in
  2634. ##    /usr/etc/hippi.imap, and returns a string containing the hex Ifield
  2635. ##    corresponding to the interface, preceded with 0x.  The empty string
  2636. ##    is returned on error.
  2637. ##
  2638. ##=============================================================================
  2639.  
  2640. #sub HostnameToIfield
  2641. #{
  2642. #        local($hostname) = @_;
  2643. #        local(@imap_entries,$entry,$h,$i,$u,$target_ip,$ip);
  2644.  
  2645. #        $target_ip = &HostnameToIPAddress($hostname);
  2646. #        @imap_entries = &ParseImapFile("/usr/etc/hippi.imap");
  2647.  
  2648. #        foreach $entry (@imap_entries)
  2649. #        {
  2650. #                ($h,$i,$u) = split(" ",$entry);
  2651. #                $ip = &HostnameToIPAddress($h);
  2652.  
  2653. #                if ($ip eq $target_ip)
  2654. #                {
  2655. #                        return($i);
  2656. #                }
  2657. #        }
  2658.  
  2659. #        return("");
  2660. #}
  2661.  
  2662. ##=============================================================================
  2663. ##
  2664. ##    DeviceNameToIfield(device,errorsfatal)
  2665. ##
  2666. ##    This routine takes a HIPPI device name and returns an ifield bound
  2667. ##    to the device.  This is done by finding the IP address bound to the
  2668. ##    device, and searching the hippi.imap file for the ifield.
  2669. ##
  2670. ##    If no IP address is bound to the device, this routine will either
  2671. ##    fail with an error message, if <errorsfatal> is set, or return an
  2672. ##    empty string.
  2673. ##
  2674. ##=============================================================================
  2675.  
  2676. #sub DeviceNameToIfield
  2677. #{
  2678. #        local($device,$errorsfatal) = @_;
  2679. #        local($hippi_number,$ip,$ifield,@result);
  2680.  
  2681. #        $ifield = "";
  2682.  
  2683. #        @result = ($device =~ /hippi(\d+)/);
  2684. #        if (@result != 1)
  2685. #        {
  2686. #                &Error(1,"Unexpected HIPPI Device '$device'\n");
  2687. #        }
  2688.  
  2689. #        @result = &GetIPByDeviceName("hip" . $result[0]);
  2690. #        if (@result >= 2)
  2691. #        {
  2692. #                $ip = $result[1];
  2693. #                $ifield = &HostnameToIfield($ip);
  2694. #        }
  2695. #            else
  2696. #        {
  2697. #                if (! $errorsfatal) { return(""); }
  2698.  
  2699. #                &Error(0,"Couldn't Find IP Address For Device '$device'\n");
  2700. #                &Suggest("Ensure Device '$device' Is Network Configured\n");
  2701. #                &ExitGracefully(1);
  2702. #        }
  2703.  
  2704. #        if ($ifield eq "")
  2705. #        {
  2706. #                if (! $errorsfatal) { return(""); }
  2707.  
  2708. #                &Error(0,"Couldn't Find Ifield For HIPPI Device '$device' ($ip)\n");
  2709. #                &Suggest("(1) Verify IP Address '$ip' (Or An **Alias) Is In '/usr/etc/hippi.imap'\n");
  2710. #                &Suggest("(2) Verify Device '$device' Should Have IP Address '$ip'\n");
  2711. #                &ExitGracefully(1);
  2712. #        }
  2713.  
  2714. #        return($ifield);
  2715. #}
  2716.  
  2717. #=============================================================================
  2718. #
  2719. #    AddSignalHandler(signal,functionname)
  2720. #
  2721. #    This routine adds the subroutine <functionname> to the list of
  2722. #    routines that are called when the signal <signal> is invoked.
  2723. #    Remove signal handlers from a signal with RemoveSignalHandler().
  2724. #    Signal handlers should not normally terminate, in order to allow
  2725. #    other signal handlers in the list to execute.  The global variable
  2726. #    $terminate_after_signal can be set by the signal handler to terminate
  2727. #    after the last signal handler is called.
  2728. #
  2729. #    This code won't work well for timeouts, because there is no
  2730. #    virtualization of timers.
  2731. #
  2732. #=============================================================================
  2733.  
  2734. sub AddSignalHandler
  2735. {
  2736.   local($signal,$functionname) = @_;
  2737.   local($h,$current,$handlers_string,@handlers);
  2738.  
  2739.   $handlers_string = $signal_handlers{$signal};
  2740.   @handlers = ();
  2741.   @handlers = split(' ',$handlers_string) if (defined($handlers_string));
  2742.  
  2743.   push(@handlers,$functionname);
  2744.  
  2745.   $current = $SIG{$signal};
  2746.   if (! defined($current)) {
  2747.     $current = "DEFAULT";
  2748.   }
  2749.   if ($current ne "main'SignalHandler") {
  2750.     if (($current ne "DEFAULT") &&
  2751.     ($current ne "IGNORE")) {
  2752.       &InternalError(__LINE__,__FILE__,
  2753.              "AddSignalHandler Has Current Handler '%s'\n",
  2754.              $current);
  2755.     }
  2756.     @handlers = ($current,@handlers);
  2757.   }
  2758.   $signal_handlers{$signal} = join(" ",@handlers);
  2759.  
  2760.   $SIG{$signal} = "SignalHandler";
  2761. }
  2762.  
  2763. ##=============================================================================
  2764. ##
  2765. ##    RemoveSignalHandler(signal,functionname)
  2766. ##
  2767. ##    This routine removes the subroutine <functionname> from the list of
  2768. ##    routines that are called when the signal <signal> is invoked.
  2769. ##    If the handler you remove is the last one added, the value of the
  2770. ##    handler before the first AddSignalHandler() call is restored.
  2771. ##
  2772. ##=============================================================================
  2773.  
  2774. #sub RemoveSignalHandler
  2775. #{
  2776. #    local($signal,$functionname) = @_;
  2777. #    local($found,$h,$current,$handlers_string,$orig,@handlers);
  2778.  
  2779. #    $handlers_string = $signal_handlers{$signal};
  2780. #    ($orig,@handlers) = split(' ',$handlers_string);
  2781.  
  2782. #    $found = 0;
  2783. #    for ($i = 0; $i <= $#handlers; $i++)
  2784. #    {
  2785. #        if ($handlers[$i] eq $functionname)
  2786. #        {
  2787. #            splice(@handlers,$i,1);
  2788. #            $found = 1;
  2789. #            last;
  2790. #        }
  2791. #    }
  2792.  
  2793. #    if (!$found)
  2794. #    {
  2795. #        &InternalError(__LINE__,__FILE__,
  2796. #            "RemoveSignalHandler Can't Find Handler '%s'\n",
  2797. #            $functionname);
  2798. #    }
  2799.  
  2800. #    if (@handlers == 0)
  2801. #    {
  2802. #        $SIG{$signal} = $orig;
  2803. #        delete($signal_handlers{$signal});
  2804.  
  2805. #    }
  2806. #        else
  2807. #    {
  2808. #        @handlers = ($orig,@handlers);
  2809. #        $signal_handlers{$signal} = join(" ",@handlers);
  2810. #    }
  2811. #}
  2812.  
  2813. ##=============================================================================
  2814. ##
  2815. ##    EnsureFileExists(pathname)
  2816. ##
  2817. ##    This routine file a program <pathname> exists and is readable.
  2818. ##
  2819. ##=============================================================================
  2820.  
  2821. #sub EnsureFileExists
  2822. #{
  2823. #    local($path) = @_;
  2824.  
  2825. #    if (! (-e $path))
  2826. #    {
  2827. #        &Error(1,"File '%s' Doesn't Exist\n",$path);
  2828. #    }
  2829.  
  2830. #    if (! (-r $path))
  2831. #    {
  2832. #        &Error(1,"File '%s' Not Readable\n",$path);
  2833. #    }
  2834. #}
  2835.  
  2836. ##=============================================================================
  2837. ##
  2838. ##    EnsureProgramExists(pathname)
  2839. ##
  2840. ##    This routine ensures a program <pathname> exists and is executable.
  2841. ##
  2842. ##=============================================================================
  2843.  
  2844. #sub EnsureProgramExists
  2845. #{
  2846. #    local($path) = @_;
  2847.  
  2848. #    if (! (-e $path))
  2849. #    {
  2850. #        &Error(1,"Program '%s' Doesn't Exist\n",$path);
  2851. #    }
  2852.  
  2853. #    if (! (-x $path))
  2854. #    {
  2855. #        &Error(1,"Program '%s' Not Executable\n",$path);
  2856. #    }
  2857. #}
  2858.  
  2859. ##=============================================================================
  2860. ##
  2861. ##    DottedAddrToAddr
  2862. ##
  2863. ##    Perl doesn't seem to be too friendly to us.  It makes us do name
  2864. ##    resolution using binary structures, but doesn't seem to provide
  2865. ##    any inet_XtoY kind of stuff.  This routine converts a dotted string
  2866. ##    IP address into a binary encoding.
  2867. ##
  2868. ##=============================================================================
  2869.  
  2870. sub DottedAddrToAddr
  2871. {
  2872.   local($dotted) = @_;
  2873.   local($binary,@fields);
  2874.  
  2875.   @fields = split("\\.",$dotted);
  2876.   if (@fields != 4) {
  2877.     &Error(1,"Not Four Fields In Addr '$dotted' (@fields)");
  2878.   }
  2879.  
  2880.   $binary = pack("C4",@fields);
  2881.   return($binary);
  2882. }
  2883.  
  2884. ##=============================================================================
  2885. ##
  2886. ##    AddrToDottedAddr
  2887. ##
  2888. ##    Perl doesn't seem to be too friendly to us.  It makes us do name
  2889. ##    resolution using binary structures, but doesn't seem to provide
  2890. ##    any inet_XtoY kind of stuff.  This routine converts a binary encoded
  2891. ##    IP address into a dotted string.
  2892. ##
  2893. ##=============================================================================
  2894.  
  2895. #sub AddrToDottedAddr
  2896. #{
  2897. #    local($binary) = @_;
  2898. #    local($dotted,@fields);
  2899.  
  2900. #    @fields = unpack("C4",$binary);
  2901. #    if (@fields != 4)
  2902. #    {
  2903. #        &InternalError(__LINE__,__FILE__,
  2904. #            "Not Four Fields In Packed Address\n");
  2905. #    }
  2906.  
  2907. #    $dotted = join(".",@fields);
  2908. #    return($dotted);
  2909. #}
  2910.  
  2911. #####################################################################
  2912. ##                   SUBROUTINE GET_REMOTE_FILE                     #
  2913. ## Gets the contents of remote_file from the remote_host, and       #
  2914. ## returns that to the caller.                                      #
  2915. ## If the file does not exist or is unreadable, it returns the      #
  2916. ## corresponding cat error msg.                                     #
  2917. #####################################################################
  2918. #sub get_remote_file {
  2919. #   local ($remote_host, $remote_file, $timeout) = @_;
  2920. #   local ($cat_cmd, $cat_out);
  2921.  
  2922. #   $cat_cmd = "/usr/bsd/rsh $remote_host -n /sbin/cat -u $remote_file";
  2923. #   $cat_out = &do_cmd_with_timeout ($cat_cmd, $timeout);
  2924.  
  2925. #   if ($? == 0) {
  2926. #      ##############################################################
  2927. #      # Check the output to see if cat gave an error msg. These    #
  2928. #      # msgs look like: UX:cat: ERROR: ...                         #
  2929. #      # No, actually let the caller take care of it ...            #
  2930. #      ##############################################################
  2931. #      return ($cat_out);
  2932. #   }
  2933. #   else {
  2934. #      &Error(1,"Remote Command '$cat_cmd' Failed With Output:\n$cat_out");
  2935. #   }
  2936. #} # end of "sub get_remote_file"
  2937.  
  2938. ######################################################################
  2939. ##                SUBROUTINE DO_CMD_WITH_TIMEOUT                     #
  2940. ## Executes the command with timeout. Sets the signal handler for    #
  2941. ## SIGALRM to lanarray_alrm_handler, resetting it back to the orig.  #
  2942. ## afterwards.
  2943. ######################################################################
  2944. sub do_cmd_with_timeout {
  2945.    local ($next_cmd, $timeout) = @_;
  2946.    local ($old_sig);
  2947.    local ($command);
  2948.  
  2949.    $old_sig = $SIG{'ALRM'}; # Save old handler name.
  2950.    $SIG{'ALRM'} = \&alarm_call;
  2951.  
  2952.    $command="\'$next_cmd ; echo \$?;\'";
  2953.    &Log ("Executing command $command");
  2954.  
  2955.    alarm ($timeout);   # Enable timeout.
  2956.    eval {@next_cmd_out = `$next_cmd `};
  2957.  
  2958.    alarm (0);          # Disable timeout.
  2959.    $SIG{'ALRM'} = $old_sig; # Reset handler to whatever it was before.
  2960.  
  2961.    if ($SIG_TIMEOUT) {
  2962.       $RSH_ERRNO=1;
  2963.       return $NULL;
  2964.    }
  2965.  
  2966.    if ($@ ne "") {
  2967.       &Failure("command failure $@\n");
  2968.       return ($NULL);
  2969.    }
  2970.  
  2971.    $RSH_ERRNO=$next_cmd_out[scalar(@next_cmd_out)-1];
  2972.  
  2973.    chop  (@next_cmd_out);
  2974.    return (@next_cmd_out);
  2975.  
  2976. } # end of "sub do_cmd_with_timeout"
  2977.  
  2978. sub do_log {
  2979.    local ($next_cmd, $timeout) = @_;
  2980.    local ($old_sig);
  2981.  
  2982.    $old_sig = $SIG{'ALRM'}; # Save old handler name.
  2983.    $SIG{'ALRM'} = 'lanarray_alrm_handler';
  2984.  
  2985.    alarm ($timeout);   # Enable timeout.
  2986.    $next_cmd_out = `$next_cmd 2>&1`;
  2987.    alarm (0);          # Disable timeout.
  2988.    $SIG{'ALRM'} = $old_sig; # Reset handler to whatever it was before.
  2989.    chop  ($next_cmd_out);
  2990.    return ($next_cmd_out);
  2991. }
  2992.  
  2993. ######################################################################
  2994. ##                SUBROUTINE LANARRAY_ALRM_HANDLER                   #
  2995. ## This routine is the SIGALRM handler used for the timeout function #
  2996. ## in lantest and arraysvcstest.                                     #
  2997. ######################################################################
  2998. sub lanarray_alrm_handler {
  2999.    local ($sig_num) = @_;
  3000.    local ($this_cmd_pid, $this_cmd_ps_out);
  3001.    local ($num_killed);
  3002.  
  3003.    # Kill all my children before exiting.
  3004.    $num_killed = &kill_all_children;
  3005.  
  3006.    &Error(0,"Operation Timed Out");
  3007.    &Suggest("(1) If Nodes In Use, Load May Be Too High");
  3008.    &Suggest("(2) Try Running Diags Again If Suspect It's A Startup Delay");
  3009.    &ExitGracefully(1);
  3010. } # end of "sub lanarray_alrm_handler"
  3011.  
  3012. #####################################################################
  3013. ##                 SUBROUTINE KILL_ALL_CHILDREN                     #
  3014. ## This routine kills all the children processes of this process.   #
  3015. ## Returns the number of children killed.                           #
  3016. #####################################################################
  3017. sub kill_all_children {
  3018.    local($count, @ppid_list, @pid_list, $this_ppid);
  3019.    local($ps_out, @ps_list, $ps_line, @ps_fields, $this_pid);
  3020.  
  3021.    $count = 0;
  3022.    $ps_out = `/sbin/ps -ef`;
  3023.    chop($ps_out);
  3024.    @ps_list = split (/\n/, $ps_out);
  3025.    push(@ppid_list, $$);
  3026.  
  3027.    while (@ppid_list) {
  3028.       $this_ppid = shift(@ppid_list);
  3029.       foreach $ps_line (@ps_list) {
  3030.          @ps_fields = split (' ', $ps_line);
  3031.          if ($ps_fields[2] == $this_ppid) {
  3032.             push(@ppid_list, $ps_fields[1]);
  3033.            push(@pid_list, $ps_fields[1]);
  3034.          }
  3035.       }
  3036.    } # while (@ppid_list)
  3037.  
  3038. ## FIX!! Make the pid_list associative, to clean up recursively.
  3039.  
  3040.    foreach $this_pid (@pid_list) {
  3041.       if (kill(9, $this_pid) != 0) {
  3042.          $count++;
  3043.       }
  3044.    }
  3045.  
  3046.    return ($count);
  3047. } # end of "sub kill_all_children"
  3048.  
  3049. ###############################################################################
  3050. ##
  3051. ##                   I N T E R N A L    R O U T I N E S
  3052. ##
  3053. ##                       (get your nose out of here)
  3054. ##
  3055. ###############################################################################
  3056.  
  3057. ##=============================================================================
  3058. ##
  3059. ##    SignalHandler(signal)
  3060. ##
  3061. ##    This routine is the entry point for a signal handler.  It calls
  3062. ##    all the user specified signal handlers that were attached to this
  3063. ##    signal handler, and then, if $terminate_after_signal is true, exits
  3064. ##    the application with error code $terminate_after_signal.
  3065. ##
  3066. ##=============================================================================
  3067.  
  3068. sub SignalHandler
  3069. {
  3070.     local($signal) = @_;
  3071.     local($h,$handlers_string,@handlers);
  3072.  
  3073.     &Notice("$0 Caught Signal '$signal'\n");
  3074.  
  3075.     $handlers_string = $signal_handlers{$signal};
  3076.     @handlers = split(' ',$handlers_string);
  3077.  
  3078.     shift(@handlers);
  3079.  
  3080.     if (@handlers == 0)
  3081.     {
  3082.         &InternalError(__LINE__,__FILE__,
  3083.             "SignalHandler Without Handlers\n");
  3084.     }
  3085.  
  3086.     $terminate_after_signal = 0;
  3087.  
  3088.     &Notice("Calling Interrupt Handlers [%s]\n",join(" ",@handlers));
  3089.  
  3090.     foreach $h (@handlers)
  3091.     {
  3092.         eval("&"."$h"."($signal)");
  3093.         if ($@ != "")
  3094.         {
  3095.             &InternalError(__LINE__,__FILE__,
  3096.                 "SignalHandler Invoke Says '$@'\n");
  3097.         }
  3098.     }
  3099.  
  3100.     if ($terminate_after_signal != 0)
  3101.     {
  3102.         &ExitGracefully($terminate_after_signal);
  3103.     }
  3104.     $SIG{$signal} = "SignalHandler";
  3105. }
  3106.  
  3107. ##=============================================================================
  3108. ##
  3109. ##    CleanUp
  3110. ##
  3111. ##    This routine is called before program exit to remove temporary
  3112. ##    files and otherwise clean up after itself.
  3113. ##
  3114. ##=============================================================================
  3115.  
  3116. sub CleanUp
  3117. {
  3118.   local($fc,$f,$c);
  3119.  
  3120.   #    &Notice("Cleaning Up Before Program '$0' Exits\n");
  3121.  
  3122.   foreach $fc (@files_to_clean) {
  3123.     ($f,$c) = split(":",$fc);
  3124.     if (-e $f) {
  3125.       &Notice("Deleting Temp File '%s' (%s)\n",$f,$c);
  3126.       unlink($f);
  3127.     }
  3128.   }
  3129. }
  3130.  
  3131. ##=============================================================================
  3132. ##
  3133. ##    UnexpectedSignalHandler
  3134. ##
  3135. ##    Clean up and exit with error 1.
  3136. ##
  3137. ##=============================================================================
  3138.  
  3139. sub UnexpectedSignalHandler
  3140. {
  3141.     &ExitGracefully(1);
  3142. }
  3143.  
  3144. #sub SpawnCommand
  3145. #{
  3146. #        local($command) = @_;
  3147. #        local($child_pid,$out_file);
  3148.  
  3149. #    $out_file = &MakeTempFile("/usr/tmp");
  3150.  
  3151. #        $child_pid = fork();
  3152. #        if ($child_pid == 0)                            # The Child Process
  3153. #        {
  3154. #                close(STDIN);
  3155. #                close(STDOUT);
  3156. #                setpgrp(0,$$);
  3157.  
  3158. #                exec("$command >$out_file 2>&1");
  3159. #                exit(0);
  3160. #        }
  3161. #            elsif ($child_pid > 0)
  3162. #        {                                               # The Parent Process
  3163. #                return($child_pid,$out_file);
  3164. #        }
  3165. #            else
  3166. #        {
  3167. #                return(-1,"");
  3168. #        }
  3169. #}
  3170.  
  3171. sub TimeoutHandler
  3172. {
  3173.         local($pid,$done);
  3174. ##
  3175. ##      Kill All Outstanding Commands
  3176. ##
  3177.         foreach $pid (keys(%DONE))
  3178.         {
  3179.                 $done = $DONE{$pid};
  3180.                 if ($done == 0)
  3181.                 {
  3182.                         $DONE{$pid} = 2;        # Timed out status
  3183.                         kill(-9,$pid);
  3184.                 }
  3185.         }
  3186.  
  3187.         $timed_out = 1;
  3188. }
  3189.  
  3190. #=============================================================================
  3191. #
  3192. #    MapFuncToStream(function,stream-name)
  3193. #
  3194. #    This function opens a stream, reads in each line from the stream,
  3195. #    and applies the perl function name to the each line.  The function
  3196. #    should return 0 for immediate termination, 1 to continue processing.
  3197. #
  3198. #=============================================================================
  3199.  
  3200. #sub MapFuncToStream
  3201. #{
  3202. #    local($func,$stream_path) = @_;
  3203. #    local($line,$cmd,$result);
  3204.  
  3205. #    open(MFTS_IN,$stream_path) ||
  3206. #        &Error("can't open stream '$stream_path'\n");
  3207.  
  3208. #    while ($line = <MFTS_IN>)
  3209. #    {
  3210. #        chop($line);
  3211. #        $cmd = "&" . "$func" . "(\"$line\");";
  3212. #        $result = eval($cmd);
  3213. #        if ($result eq undef)
  3214. #        {
  3215. #            chop($@);
  3216. #            &InternalError("MapFuncToStream",$@);
  3217. #        }
  3218. #        if ($result == 0) { last; }
  3219. #    }
  3220. #    close(MFTS_IN);
  3221. #}
  3222.  
  3223. #=============================================================================
  3224. #
  3225. #    Executable Commands
  3226. #
  3227. #=============================================================================
  3228.  
  3229. &AddSignalHandler("INT","UnexpectedSignalHandler");
  3230. &AddSignalHandler("SEGV","UnexpectedSignalHandler");
  3231. &AddSignalHandler("BUS","UnexpectedSignalHandler");
  3232. &AddSignalHandler("HUP","UnexpectedSignalHandler");
  3233. &AddSignalHandler("PIPE","UnexpectedSignalHandler");
  3234.  
  3235. #
  3236. # The following is for [x]emacs...
  3237. # Local Variables:
  3238. # perl-indent-level:8
  3239. # End:
  3240.